Toon posts:

[excel2010 VBA] copy alleen waarden, geen formules

Pagina: 1
Acties:

Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
Ik probeer meerdere sheets samen te voegen in 1 sheet,
onderstaande code werkt, met 1 probleem, ik wil alleen waardes kopieren en niet formules.
Heb geprobeerd dit op te lossen en ook om dit zonder select op te pakken maar ik ben door de bomen het bos kwijt. Iemand een goede tip / duw de juiste kan op?

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Sub Workbook_Open()
MsgBox "De inhoud is nu automatisch bijgewerkt." & vbNewLine & "Om het overzicht te actualiseren druk op 'update'."
Call Portfoliossamenvoegen

End Sub

Sub Portfoliossamenvoegen()
    Dim J As Integer

    On Error Resume Next
    
    'Sheets(1).Activate 
    Sheets(1).Select  
    Range("A3:ZZ1000").ClearContents 
    
    Application.ScreenUpdating = False 
   
    For J = 3 To 7 'alleen die sheets moeten gekopieerd worden
        Sheets(J).Activate 
        Range("A3").Select
        Selection.CurrentRegion.Select 
        Selection.Offset(2, 0).Resize(Selection.Rows.Count - 2).Select 'eerste 2 rijen niet
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) 
              
    Next
       
    Application.ScreenUpdating = True
    Sheets(1).Activate 
End Sub


heb pastespecial etc. geprobeerd maar kom er niet uit |:( 8)7

Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
het kan vast netter, maar zo werkt het in ieder geval:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Portfoliossamenvoegen()
    Dim J As Integer

    On Error Resume Next
    
    Sheets(1).Select  'selecteer sheet 1
    Range("A3:ZZ1000").ClearContents 'delete alles in de totaalsheet behalve de titelregels (kies hier dus juiste range)
    
    Application.ScreenUpdating = False 'voorkom heen en weer flipperen tussen schermen
   
    Dim laatsterijbron As Double
    Dim laatsterijdoel As Double
       
    For J = 3 To 7 'FOR loop, alleen voor sheets x t/m y?
        Sheets(1).Activate '1e sheet selecteren
        With ActiveSheet
            laatsterijdoel = .Cells(.Rows.Count, "A").End(xlUp).Row 'wat is de laatste rij van sheet 1?
        End With
         
        Sheets(J).Activate 'sheet J activeren
        With ActiveSheet
            laatsterijbron = .Cells(.Rows.Count, "A").End(xlUp).Row 'wat is de laatste rijd van sheet J?
        End With
        'doel is Sheets(1) vanaf laatste rij tot daar waar nodig (dus laatste rij bron -2 kopregels), bron is Sheets(J) vanaf A3 tot aan laatste regel
        Sheets(1).Range("A" & laatsterijdoel + 1 & ":ZZ" & laatsterijdoel + laatsterijbron - 2) = Sheets(J).Range("A3:ZZ" & laatsterijbron).Value
        
    Next
       
    Application.ScreenUpdating = True
    Sheets(1).Activate
End Sub