Samenvoegen

[Warme bakkertje]

Sub samenvoegen()

    Application.ScreenUpdating = False
    mySheetArray = Array("Object", "Installatie", "Systeem", "Assembly", "Component")
        For Each it In mySheetArray
            If Sheets(it).Range("A1").CurrentRegion.Rows.Count < 2 Then GoTo vervolg
            Sheets("Upload").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Sheets(it).Cells(1).CurrentRegion.Rows.Count - 1, 10) = _
                Sheets(it).Range("A2:J" & Sheets(it).Cells(1).CurrentRegion.Rows.Count).Value
vervolg:
        Next
    Application.ScreenUpdating = True
    
End Sub

 

[henryvanbeek]

Dit doet het prima :d

Rudi en Vena Bedankt voor mij is dit case closed