將數據從所有書籍中提取到某個表格

Question

我在EXCEL中很新（尤其是在VBA中）。我試圖寫出如下邏輯：

轉到所有打開的書籍，如果某些書的名稱爲「測試」，應該從命名範圍「表」中獲取數據，然後將其附加到表1中的ALLDATA表中ALLDATABOOK。我試圖寫這個，有人可以幫我嗎？

這裏是我的代碼：

Private Sub CommandButton1_Click() 
    Dim book As Object 
    Dim lst As ListObject 
    Dim iList As Worksheet 
    For Each book In Workbooks 

    For Each iList In book.Sheets 
     If iList.Name = "Test" Then 

     book.Sheets(iList.Name).Activate 
Range("Table").Select 


     End If 
    Next 

    Next 
End Sub 

Answer 1

試試這個（Excel文件2007+寫的，可能不適用於早期版本的工作）

Private Sub CommandButton1_Click() 
    Dim book As Workbook 
    Dim lst As ListObject 
    Dim iList As Worksheet 
    Dim Rng As Range 

    Dim wbAllDataBook As Workbook 
    Dim shAllData As Worksheet 

    ' Get reference to ALLDATA table 
    Set wbAllDataBook = Workbooks("ALLDATABOOK.xlsm") '<-- change to suit your file extension 
    Set shAllData = wbAllDataBook.Worksheets("ALLDATA") 
    Set lst = shAllData.ListObjects("Table1") 

    For Each book In Workbooks 
     ' Use error handler to avoid looping through all worksheets 
     On Error Resume Next 
     Set iList = book.Worksheets("Test") 
     If Err.Number <> 0 Then 
      ' sheet not present in book 
      Err.Clear 
      On Error GoTo 0 
     Else 
      ' If no error, iList references sheet "Test" 
      On Error GoTo 0 
      ' Get Reference to named range 
      Set Rng = iList.[Table] 
      ' Add data to row below existing data in table. Table will auto extend 
      If lst.DataBodyRange Is Nothing Then 
       ' Table is empty 
       lst.InsertRowRange.Resize(Rng.Rows.Count).Value = Rng.Value 
      Else 
       With lst.DataBodyRange 
        .Rows(.Rows.Count).Offset(1, 0).Resize(Rng.Rows.Count).Value = Rng.Value 
       End With 
      End If 
     End If 
    Next 
End Sub 

---

更新：

使用Excel 2003替換

If lst.DataBodyRange Is Nothing Then 

與

If Not lst.InsertRowRange Is Nothing Then