Hallo aljechin,

ik denk dat ik spreek uit naam van alle Excel-helpers, als ik zeg dat de uitleg over je probleem te minimaal is uitgelegd... Sorry 

Je wilt één Excel-bestand maken van/met 33 Excel-bestanden?

Wat is het doel van één bestand, en wat zal het doel zijn van de samengevoegde bestanden?

Wat is de gemeenschappelijke factor bij al die bestanden?

Kan je voorbeeldbestanden aanhangen?

SoftAid              


 

Aljechin,
Deze code vond ik op internet.
Heb ze niet geprobeerd.

Sub VoegExcelBestandenSamenIn1NieuwBlad()
' [TOPIC=848630///][NOHTML][rml][ Excel] Meerdere bestanden samenvoegen[/rml][/NOHTML][/TOPIC]
' deel 2

Dim wbSingleWorkbook As Excel.Workbook, wbFinalWorkbook As Excel.Workbook
Dim wsSingleSheet As Excel.Worksheet, wsFinalSheet As Excel.Worksheet
Dim strPath As String, strWorkbook(500) As String ' max 500 bestanden
Dim intCounter As Integer, n As Integer
Dim Answer As VbMsgBoxResult

    strPath = "c:\test\"         ' Map met .xls-bestanden
    intCounter = 1              ' teller
    strWorkbook(intCounter) = Dir(strPath & "*.xls")
     
    Do While strWorkbook(intCounter) <> ""
     
        intCounter = intCounter + 1
        strWorkbook(intCounter) = Dir
         
    Loop
     
    intCounter = intCounter - 1 ' want de laatste is leeg
    Set wbFinalWorkbook = Workbooks.Add
    Application.DisplayAlerts = False
     
    Do While wbFinalWorkbook.Sheets.Count > 1
     
        wbFinalWorkbook.Sheets(1).Delete
     
    Loop                        ' We hebben maar 1 blad nodig
     
    Application.DisplayAlerts = True
    Set wsFinalSheet = wbFinalWorkbook.Sheets(1)
         
    On Error GoTo Einde         ' Error trapping AAN
     
    For n = 1 To intCounter
     
        Set wbSingleWorkbook = Workbooks.Open(Filename:=strPath _
            & strWorkbook(n), ReadOnly:=True)
             
        For Each wsSingleSheet In wbSingleWorkbook.Sheets
             
            wsSingleSheet.UsedRange.Copy _
                Destination:=wsFinalSheet.Cells _
                (wsFinalSheet.Cells.SpecialCells _
                (xlCellTypeLastCell).Row + 1, 1)
             
        Next wsSingleSheet

        wbSingleWorkbook.Close
     
    Next n
     
    On Error GoTo 0             ' Error trapping UIT
     
Einde:

    Select Case Err.Number      ' Foutmelding 1004 is
                                ' hoogstwaarschijnlijk veroorzaakt
        Case 1004               ' door iets te plakken dat boven
                                ' de 65536 rijen uit zou komen
            Answer = MsgBox(Err.Description & Chr(13) & Chr(13) & _
                "Waarschijnlijk wordt dit bestand te groot..." & _
                Chr(13) & "Verder gaan op nieuw blad?", _
                vbCritical Or vbYesNo, "Error " & Err.Number & _
                ": " & Err.Description)
             
            If Answer = vbYes Then
             
                Set wsFinalSheet = wbFinalWorkbook.Sheets.Add
                Resume
                 
            End If
             
        Case 0                  ' Niks aan 't handje :-)
             
        Case Else               ' Overige foutmeldingen
         
            MsgBox Err.Description, _
                vbCritical Or vbOKOnly, "Error " & Err.Number & _
                " in bestand " & n
     
    End Select
     
    Set wbSingleWorkbook = Nothing
    Set wbFinalWorkbook = Nothing
    Set wsSingleSheet = Nothing
    Set wsFinalSheet = Nothing

End Sub

De rode tekst c:/test/  zal moeten aangepast worden aan het path waar uw bestanden staan.

Firmin

Bedankt Firmin,

gelukt én nogmaals bedankt voor de prima instructies.