VBA zu kombinieren .xlsx Arbeitsmappen mit mehreren Blättern

Question

Guten Abend,

Ich bin auf diese für die letzten paar Tage ratlos gewesen. Ich versuche, ein Makro zu erstellen, mehrere Arbeitsmappen zu kombinieren, alle mit denselben Blattnamen, denselben Kopfzeilen, wobei nur die Dateneingabe unterschiedlich ist (was Formeln in den Zellen und Zellformatierung einschließt).

Das Endziel ist es, die letzte Arbeitsmappe alle die gleichen Blätter enthalten, aber mit den Daten kombiniert, so zum Beispiel Blatt A alle Daten aus allen Blatt wie in verschiedenen Arbeitsmappen, und dasselbe mit Tabellen B, C, D und so weiter. Der Teil, den ich immer wieder rümpfte, ist, dass ich entweder eine Arbeitsmappe mit allen Blättern, aber getrennt habe, oder am Ende eine Arbeitsmappe, die alle Daten von Sheets AM in einem Blatt und allen Formatierungen zusammenfasst ist entfernt. Ich könnte wirklich Hilfe gebrauchen, um den richtigen Code dafür herauszufinden.

Answer 1

Hoffe, das könnte helfen.

Sub doCombine() 
    Dim worksheets() As Variant 
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, excelObj As Object 
    Dim LastRow As Long 
    Application.ScreenUpdating = False 
    Set mergeObj = CreateObject("Scripting.FileSystemObject") 

    'Find workbooks from a folder 
    Set dirObj = mergeObj.Getfolder("C:\ExcelCombine") 
    Set filesObj = dirObj.Files 
    'Find workbooks from a folder end 

    For Each excelObj In filesObj 
     Set wb = Workbooks.Open(excelObj) 
     Dim worksheetName As String 
     worksheetName="WS" 
     Dim row As Integer 
     row=8 

     With wb.worksheets(worksheetName) 
      Do While Not IsEmpty(.Range("A" & row).Value) 
       .Range("A" & row & ":M" & row).Copy 
       ThisWorkbook.worksheets(worksheetName).Range("A" & row).EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow 
       ThisWorkbook.worksheets(worksheetName).Range("A" & row).End(xlUp).Offset(1, 0).PasteSpecial 
       row = row + 1 
      Loop 
     End With 
     Application.CutCopyMode=False 
    Next excelObj 
End Sub