Excel bestanden samenvoegen

[HWV]

Beste,

Ik heb een map met ruim 100 worksheets met een lijst met locatie`s ed.
Nu wil ik deze lijsten samenvoegen in 1 bestand.
Waarschijnlijk een blackoud maar weet even niet hoe ik dit moet doen.
We moeten zondag de invetaris opnieuw gaan inlezen maar moet dan namelijk wel 1 excel bestand aanleveren.
In de bijlage een voorbeeld hoe de lijsten zijn opgebouwd.
De opmaak is bij alle lijsten het zelfde, de namen zijn wel anders
1A
1B
1C
enz
maar ook
2A
2B
enz

Groet HWV

 

[Cobbe]

Heb je de ASAP Utilities? Dan is dat een fluitje van een cent.

Bladen - 16 (samenvoegen........)

Alles wordt nu op één blad gezet en kun je eventueel de dubbels en de lege rijen eruit halen.

Cobbe

 

[HWV]

Bedankt voor de reactie.
Het staat wel in verschilende bestanden.
en zou snel overgezet moeten worden ivm de tijd, om maandag weer gewoon te draaien

groet HWV

 

[HWV]

Een stap verder

Sub Macro()
    c0 = Dir("H:\Helpmij\samenvoegen\*.xls")
    Do
      With Workbooks.Add("H:\Helpmij\samenvoegen\" & c0)
   
   Sheets("EXPSTO5GST1").Select
   Dim c As Range
   For Each c In [A1:A10000]
        If c > "0" Then
            c.Rows.EntireRow.Copy
            Workbooks("TotaalLijst.xls").Sheets("Totaal").Select
            ['Totaal'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next

      End With
      c0 = Dir
    Loop Until c0 = ""
End Sub

Ik heb bovenstaande code maar krijg een foutmelding op de regel :

            Workbooks("TotaalLijst.xls").Sheets("Totaal").Select

Wat doe ik verkeerd ?

Groet HWV

 

[HWV]

Sub Macro()

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

    c0 = Dir("H:\Helpmij\samenvoegen\*.xls")
    Do
      With Workbooks.Add("H:\Helpmij\samenvoegen\" & c0)
   
   Sheets("EXPSTO5GST1").Select
   Dim c As Range
   For Each c In [A2:A10000]
        If c > "0" Then
            c.Rows.EntireRow.Copy
           Workbooks("TotaalLijst.xls").Sheets("Totaal").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
        End If
    Next
    
      End With
      c0 = Dir
    Loop Until c0 = ""
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub

Deze werkt nu naar behoren, enkel de geopende velden moeten nog gesloten worden nadat de gegevens zijn overgekopieerd.
enig iedee hoe dit nu moet

Groet HWV