问题
I am very new in EXCEL (especially in VBA). I try to write logic that:
go to all open books, if some book has sheet with name "Test", it should take data from named range "Table" and then append it to the Table1 from sheet ALLDATA in book ALLDATABOOK. I try to write this, can someone help me?
Here is my code:
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
回答1:
Try this (written for Excel 2007+, may not work for earlier versions)
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
Update:
To use with Excel 2003 replace
If lst.DataBodyRange Is Nothing Then
with
If Not lst.InsertRowRange Is Nothing Then
来源:https://stackoverflow.com/questions/12508939/take-data-from-all-books-to-some-table