合併許多獨立工作簿中的表格

Question

我想將2713個工作簿的特定內容合併到一張工作表中。可以說，單個文件包含不同銷售網點的銷售收入。

每個工作簿只使用1個工作表。每個工作表都包含一個或多個相同格式的表。工作表不包含任何功能。此示例示出了單元格A1：E7

A1包含特定插座的編號包含參考日期的A2，例如， 31.12.2014 A3：E3包含列標題：否。項目;當期收入;收入上期 A4：E10包含我想運到新的單個文件 A11的信息：E11包含總額 第12行是空白 與2013年12月31日信息表中的另一個從13行 開始...

大多數工作表都有不止一個表。他們都像上面那樣開始。這些表格具有相同的佈局。

不幸的是，產品數量差異很大（1-250）。例如，我只是假設了它的7種產品。我不需要該行的標題或總數。

如何將這些行放入新的單個工作表中？ 應在單元格中將單元格A1中每個工作表的單元號添加到包含註釋的單元格的右側。

我想避免必須一個接一個地打開2713個文件，以複製和粘貼2713中的信息，將其拖放到合併的工作表中。

我希望你能幫忙，否則會是一個漫長的週末。 最好的祝福， 彼得

Answer 1

我在這裏假設，當你說表你的意思是定義的數據表。 下面的代碼假定所有的表都是相同的大小（目標和源表）。 有沒有錯誤檢查和最小的測試 - 所以先檢查一些測試工作簿。

Sub GetTables() 

    Dim colWrkBks As Collection 'Contains path to all workbooks. 
    Dim vPath As Variant 'Current workbook path. 
    Dim wrkBk As Workbook 'Current workbook. 
    Dim wrksht As Worksheet 'Worksheet within wrkBk. 
    Dim oListObject As Object 'Tables within wrksht. 
    Dim oTargetTable As Object 'The table to hold all the data. 
    Dim sTmp As String 
    Dim sDirectory As String 

    'Make sure you have a table defined to place all the data in. 
    'Update worksheet and table name as required. 
    Set oTargetTable = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1") 

    'Get full path of all workbooks in source folder. 
    '*Update directory and file extension as required 
    Set colWrkBks = New Collection 
    sDirectory = "C:\Users\Darren\Documents\Work\New folder\" 
    sTemp = Dir$(sDirectory & "*.xls*") 
    Do While Len(sTemp) > 0 
     colWrkBks.Add sDirectory & sTemp 
     sTemp = Dir$ 
    Loop 

    'Open each workbook and copy the data from source table to target table. 
    For Each vPath In colWrkBks 
     Set wrkBk = Workbooks.Open(vPath, False) 

     '1 references the first worksheet - you can use "Sheet1" for a specific sheet name. 
     Set wrksht = wrkBk.Worksheets(1) 

     'Cycle through each table in the worksheet. 
     For Each oListObject In wrksht.ListObjects 
      oTargetTable.ListRows.Add 
      oListObject.DataBodyRange.Rows("1:" & oListObject.DataBodyRange.Rows.Count).Copy _ 
       oTargetTable.DataBodyRange.Rows(oTargetTable.DataBodyRange.Rows.Count) 
     Next oListObject 
     wrkBk.Close False 
    Next vPath 

End Sub