複数のワークブックからのワークシート・データのコピーとワークシートによるマスター・データ・ファイルへの貼り付け

Question

VBAの初心者ですが、VBAの使用を完了するための作業がありました。異なるワークブックの複数のワークシートのデータをコピーして別のワークブック（マスターデータファイル）に貼り付けるコードを、このマスターデータファイルに全く同じ数のワークシートを追加することによって作成するにはどうすればよいですか？つまり、私はマスターデータファイル内の別のワークシートにコピーされているすべてのワークシートを表示したいと思います。

データをコピーして1つのワークシートに貼り付けるコードを取り除くことができましたが、ワークシートを1つずつコピーして別のワークシートにコピーするのは苦労しています。

お手数をおかけします。

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

以下のコードを参照してください。私はコードを少し修正していくつかのノートを作りました。

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