Code aanpassen ??

[grema]

Beste ,

Gebruik onderstaande code: ( gevonden op dit forum- maar weet niet meer waar--alvast dank aan de ontwerper ervan)

Wanneer ik nu een 2 Bladen extra aanmaak als info ; komen deze tussen mijn lijst te staan op tabblad1. Het is de bedoeling dat deze niet meedraaien in de Code.

Weet iemand hoe je dit kan oplossen ?

Sub Alles_naar_Totaal()
    Dim x As Long
    Dim i As Integer
    Application.ScreenUpdating = False
    Range("A5:H10000").ClearContents
    For i = 2 To Sheets.Count - 4
        Worksheets(i).Activate
        x = Cells(Rows.Count, "A").End(xlUp).Row
        Range("A6:" & "H" & x).Copy
        Worksheets(1).Activate
        Range("A6").Select
        Range("A" & CStr(Rows.Count)).End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteAll
    Next i
    Application.CutCopyMode = False
    Range("A6").Select
    Application.ScreenUpdating = True
End Sub

groet

grema

 

[Wigi]

Sub Alles_naar_Totaal()
    
    Dim x As Long
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    Range("A5:H10000").ClearContents
    
    For i = 2 To Sheets.Count - 4
        
        With Sheets(i)
            
            If .Name <> "eerste sheet die je uitsluit" And .Name <> "tweede sheet die je uitsluit" Then
            
                x = .Cells(Rows.Count, "A").End(xlUp).Row
                .Range("A6:" & "H" & x).Copy Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)
                
            End If
        End With
    Next
    
    Application.CutCopyMode = False
    Range("A6").Select
    Application.ScreenUpdating = True
End Sub

Zoals de vorige keren, leg deze code maar naast de code van jou en bestudeer de verschillen. Dat is de beste leerschool.

Wigi

 

[grema]

Thx Wigi.

je hebt het probleem maar weer eens opgelost en ik heb er iets van opgestoken.

Alvast dank :thumb: en tot een dezer.

groet

grema