Question

我正在尝试从外部工作簿中复制标题为Field_1，Field_2，......的数据，一直到Field_10，而不必先打开它们。我想将这些数据添加到工作表2中，一直到我的主工作簿的第11页。我已经有成功添加新空表的代码并将它们重命名为Field_1，依此类推（即Sheet2变为Field_1）。我遇到的问题是将数据复制到每张表中。

到目前为止，我已成功编写代码来检索数据，我可以将所有数据粘贴到Sheet2中（如星号第一行下面的代码所示），但数据会在每个循环中相互覆盖。查看sheetID每个循环不会将任何内容粘贴到任何单元格中。我已经将我的整个代码包含在内了。重要部分包含在星号中。

Sub ADDCLM7()
On Error Resume Next
Dim Dept_Row As Long
Dim Dept_Clm As Long
Dim Lookup_Row As Long
Dim Lookup_Clm As Long
Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String
Dim FilePath$, Row&, Column&, Address$

Range("AA2").Activate
i = 1
While i < 11
    Table1 = Sheet1.Range("AB2:AB28471")

    fileTitle = "Field_"
    fileTitle = fileTitle & CStr(i) & ".xls"
    SheetName = "Sheet1"
    NumRows = 77 
    NumColumns = 2
    FilePath = ActiveWorkbook.Path & "\"

    DoEvents
    Application.ScreenUpdating = False
    If Dir(FilePath & fileTitle) = Empty Then
        MsgBox "The file " & fileTitle & " was not found", , "File Doesn't Exist"
        Exit Sub
    End If
    For Row = 1 To NumRows
        For Column = 1 To NumColumns
            Address = Cells(Row, Column).Address
'*************************************************************************************************
             Sheet2.Cells(Row, Column) = GetData(FilePath, fileTitle, SheetName, Address) ' THIS ONLY PASTES INTO SHEET2

            'sheetID = "Sheet"
            'sheetID = sheetID & CStr(i)
            'sheetID.Cells(Row, Column) = GetData(FilePath, fileTitle, SheetName, Address) ' THIS DOESNT PASTE ANYTHING
'*************************************************************************************************
        Next Column
    Next Row
    ActiveWindow.DisplayZeros = False

Table2 = Sheet2.Range("A2:B77")
Dept_Row = Sheet1.Range("AB2").Row 
Dept_Clm = Sheet1.Range("AB2").Column
Lookup_Row = Sheet1.Range("AA2").Row
Lookup_Clm = Sheet1.Range("AA2").Column

i = i + 1
For Each cl In Table1
    lookupCode = Sheet1.Cells(Lookup_Row, Lookup_Clm).Value
    Sheet1.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(lookupCode, Table2, 2, False)
  Dept_Row = Dept_Row + 1
  Lookup_Row = Lookup_Row + 1
Next cl
Wend
End Sub

非常感谢任何帮助。

Answer 1

这是因为SheetId是一个字符串而不是循环中的工作表，因此没有方法或属性Cells。

更改此行：

sheetID.Cells(Row, Column) = GetData(FilePath, fileTitle, SheetName, Address)

要：

ThisWorkbook.Worksheets(sheetID).Cells(Row, Column) = GetData(FilePath, fileTitle, SheetName, Address)

作为旁注，我建议将Option Explicit添加到代码的最顶层并声明所有变量，以便将来避免此类问题。

使用VBA将数据添加到连续的Excel工作表中

1 个答案: