複数のシートと複数のファイルから特定のブックに複数のファイルを編集するためのVBAコード

Question

約15枚のワークブックがあり、それぞれがセル「A1」から「Z1」データのデータを含む約5000枚です。これらのシートをすべて「コンパイル済み」という名前のファイルにコンパイルする必要があります。

単純に言えば、15 xlsmファイルに1つのシートに1つのデータ行があります。これらの行はすべて1つのシートにコンパイルする必要があります。

しかし、 "12345A"、 "B1"にはいくつかのデータ、 "C1"にはいくつかのデータが含まれています。

"A1"、 "B1"、 "C1"データを共有するシートがあります。したがって、これらのシートからデータをコピーする場合、VBAコードは、この "A1"、 "B1"、 "C1"データを持つ行が既にコピーされているかどうかを確認し、特定の行の下の "D1"を "AB1"

サンプルシート

楽しんで ​​

Private Sub Compiled() 

Dim thisWS As Worksheet, sheet As Worksheet 
Dim compiled As Workbook, thatWB As Workbook 

Dim path As String, fileName As String, compiledpath As String 
path = "C:\Users\User\Desktop\New folder\" 
fileName = Dir(path & "*.xlsm") 
compiledpath = "C:\Users\User\Desktop\compiled.xlsm" 

Set compiled = Workbooks(compiledpath) 
Set thisWS = compiled.Sheets("List") 

Dim arr(75000) As String 
Dim counter As Long 
counter = 0 
Do While Len(fileName) > 0 
    Set thatWB = Workbooks.Open(path & fileName, True, True) 
     For Each sheet In thatWB.Sheets 
      arr(counter) = thatWB.sheet.Range("A1").Value 
     Next sheet 
    counter = counter + 1 
    thatWB.Close Flase 
    fileName = Dir() 
Loop 
thisWS.Range(thisWS.Cells(1, 1), thisWS.Cells(coutner, 1)).Value2 = arr 
End Sub 

Answer 1

をコンパイルしたサンプル：P

Private Sub this() 
    Dim path As String, fileName as string 
    path = "c:\" 
    fileName = Dir(path & "*.xl??") 
    dim thisWS as worksheet, sheet as worksheet 
    set thisWS = ThisWorkbok.Sheets("Sheet1") 
    dim thatWB as workbook 
    dim arr(75000) as string 
    dim counter as long 
    counter = 0 
    Do While Len(fileName)>0 
     Set thatWB = WorkBooks.Open(path & fileName, True, true) 
      For Each sheet in thatWB.Sheets 
       arr(counter) = thatWB.sheet.Range("A1").Value 
      next sheet 
     counter = counter + 1 
     thatWB.close Flase 
     fileName = Dir() 
    Loop 
    thisWS.Range(thisWS.Cells(1,1), thisWS.Cells(coutner,1).Value2 = arr 
End Sub