Excel 以编程方式将多个工作簿中特定单元格的数据复制到“主工作簿”

我有两个问题，但首先是背景知识

我有许多工作簿，每个工作簿包含不同数量的工作表，所有工作表都保存在同一文件夹中。除第一个工作表外，每个工作表都有一张发票，我需要从中将特定单元格中的数据复制到主工作表中

主工作表有5列，其中将填充来自下一行每张工作表上相同5个单元格的信息

Invoice Sheets Cell  Master Sheet Row
     E9                   A
     D18                  B
     D22                  C
     E11                  D
     F27                  E

因此，我的第一个问题是-我如何修改此代码，使其将正确的信息粘贴到正确的单元格中

第二，我还没有尝试在工作手册中的每一页上循环，因为我不知道从哪里开始

任何未经测试的建议都将不胜感激：

Sub Consolidate()

Dim wkbkorigin As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim ResultRow As Long
Dim Fname As String
Dim RngDest As Range


    Set destsheet = ThisWorkbook.Worksheets("Sheet1")
    Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp) _
                       .Offset(1, 0).EntireRow
    Fname = Dir(ThisWorkbook.Path & "/*.xlsx")

    'loop through each file in folder (excluding this one)
    Do While Fname <> "" And Fname <> ThisWorkbook.Name

        If Fname <> ThisWorkbook.Name Then

            Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)
            Set originsheet = wkbkorigin.Worksheets("Sheet1")

            With RngDest
                .Cells(1).Value = originsheet.Range("E9").Value
                .Cells(2).Value = originsheet.Range("D18").Value
                .Cells(3).Value = originsheet.Range("D22").Value
                .Cells(4).Value = originsheet.Range("E11").Value
                .Cells(5).Value = originsheet.Range("F27").Value
            End With

            wkbkorigin.Close SaveChanges:=False   'close current file
            Set RngDest = RngDest.Offset(1, 0)

        End If

        Fname = Dir()     'get next file
    Loop
End Sub

---

那么，您想将信息复制到每个工作簿中的第一张工作表，还是复制到包含宏的工作簿中的一张工作表？从代码中理解有点困难。嗨，Tim，信息将被复制到包含宏的名为master的工作簿中Sheet1的下一个空行中。谢谢你的回复。

Sub Consolidate()

Dim wkbkorigin As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim ResultRow As Long
Dim Fname As String
Dim RngDest As Range


    Set destsheet = ThisWorkbook.Worksheets("Sheet1")
    Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp) _
                       .Offset(1, 0).EntireRow
    Fname = Dir(ThisWorkbook.Path & "/*.xlsx")

    'loop through each file in folder (excluding this one)
    Do While Fname <> "" And Fname <> ThisWorkbook.Name

        If Fname <> ThisWorkbook.Name Then

            Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)
            Set originsheet = wkbkorigin.Worksheets("Sheet1")

            With RngDest
                .Cells(1).Value = originsheet.Range("E9").Value
                .Cells(2).Value = originsheet.Range("D18").Value
                .Cells(3).Value = originsheet.Range("D22").Value
                .Cells(4).Value = originsheet.Range("E11").Value
                .Cells(5).Value = originsheet.Range("F27").Value
            End With

            wkbkorigin.Close SaveChanges:=False   'close current file
            Set RngDest = RngDest.Offset(1, 0)

        End If

        Fname = Dir()     'get next file
    Loop
End Sub