Kopieren von Arbeitsblattdaten aus mehreren Arbeitsmappen und Einfügen in eine Stammdatendatei durch Arbeitsblatt

Question

Ich bin völlig neu in VBA, aber ich hatte eine Aufgabe mit VBA abgeschlossen. Wie erstelle ich einen Code, der die Daten mehrerer Arbeitsblätter aus verschiedenen Arbeitsmappen kopiert und in eine andere Arbeitsmappe (Stammdatendatei) einfügt, indem dieser Stammdatendatei genau die gleiche Anzahl separater Arbeitsblätter hinzugefügt wird? Das heißt, ich möchte alle Arbeitsblätter anzeigen, die in separate Arbeitsblätter in der Stammdatendatei kopiert werden.

Ich habe es geschafft, einen Code zu ziehen, der die Daten kopiert und in ein einziges Arbeitsblatt einfügt, aber ich habe Mühe, sie über eins nach dem anderen zu kopieren, um Arbeitsblätter zu trennen.

Ihre Hilfe wird sehr geschätzt.

Sub datatransfer() 

    Dim FolderPath, FilePath, Filename, targetfile As String 
    Dim wb1, wb2 As Workbook 
    Dim i, mycount As Long 

    targetfile = "Left the location out on purpose" 
    FolderPath = " Left the location out on purpose " 
    FilePath = FolderPath & "*.xls*" 

    Filename = Dir(FilePath) 

    Dim lastrow, lastcolumn As Long 

    Do While Filename < "" 

     mycount = mycount + 1 

     Filename = Dir() 

     Set wb1 = Workbooks.Open(FolderPath & Filename) 

     lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 

     lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column 

     Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy 

     Application.DisplayAlerts = False 

     Set wb2 = Workbooks.Open(targetfile) 

     Worksheets.Add Before:=Sheet1, Count:=2 


     For i = 1 To mycount 

      With Worksheets(i) 

       ActiveSheet.Paste Destination:=.Range(Cells(2, 2), Cells(2, lastcolumn)) 

      End With 

     Next i 

     ActiveWorkbook.Close SaveChanges:=True 

     Filename = Dir 

    Loop 

End Sub 

Answer 1

Siehe Code unten. Ich habe einige Notizen gemacht, wo ich den Code ein wenig modifiziert habe, um sicherzustellen, dass er mit zukünftigen Problemen funktioniert.

Sub datatransfer() 

    'have to specify type for all variables, techinically it still works the way you did, but you are setting unncessary memory 
    Dim FolderPath As String, FilePath As String, Filename As String, targetfile As String 
    Dim wb1 As Workbook, wb2 As Workbook 

    targetfile = "Left the location out on purpose" 
    FolderPath = " Left the location out on purpose " 
    FilePath = FolderPath & "*.xls*" 

    Set wb2 = Workbooks.Open(targetfile) 'only need to open this once and leave open until execution is finished 

    Filename = Dir(FilePath) 

    Do While Filename <> "" ' need "<>" to say not equal to nothing 

     wb2.Worksheets.Add After:=wb2.Worksheets(wb2.Worksheets.Count) 'add new sheet to paste data in target book 

     Set wb1 = Workbooks.Open(FolderPath & Filename) 

     Dim lastrow As Long, lastcolumn As Long 

     With wb1.Worksheets(1) 'best to qualify all objects and work directly with them 
      lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row 
      lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 

      'pretty sure you want to add this A1, since it's a new blank sheet 
      .Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy _ 
       Destination:=wb2.Worksheets(wb2.Worksheets.Count).Range("A1") 

     End With 

     wb1.Close False 'assume no need to save changes to workbook you copied data from 

     Filename = Dir 

    Loop 

    wb2.Close True 'no close and save master file 

End Sub