VBA与ChatGPT联手，轻松实现Excel数据提取与汇总！

完整代码如下：

Sub SalesSummary()

  Dim ws As Worksheet

  Dim summaryWs As Worksheet

  Dim wb As Workbook

  Dim myPath As String

  Dim myFile As String

  Dim myExtension As String

  Dim targetRow As Long

   

  '定义目标工作簿和工作表

  Set summaryWs = ThisWorkbook.Sheets("Sheet1")

   

  '定义文件路径和文件类型

  myPath = "C:\Users\Administrator\Desktop\DEMO\每月销售数据\"

  myExtension = "*.xlsx"

   

  '目标行从第2行开始（假设第1行是标题）

  targetRow = 2

   

  '获取文件夹中的第一个文件

  myFile = Dir(myPath & myExtension)

   

  '循环，直到没有文件

  Do While myFile <> ""

     

    '打开文件

    Set wb = Workbooks.Open(Filename:=myPath & myFile)

     

    '设置工作表为 "销售数据"

    Set ws = wb.Sheets("销售数据")

     

    '从"销售数据"工作表复制数据到"销售汇总表"

    summaryWs.Cells(targetRow, "A").Value = ws.Range("A2").Value

    summaryWs.Cells(targetRow + 1, "A").Value = ws.Range("A3").Value

    summaryWs.Cells(targetRow + 2, "A").Value = ws.Range("A4").Value

    summaryWs.Cells(targetRow, "B").Value = ws.Range("B2").Value

    summaryWs.Cells(targetRow + 1, "B").Value = ws.Range("B3").Value

    summaryWs.Cells(targetRow + 2, "B").Value = ws.Range("B4").Value

    summaryWs.Cells(targetRow, "C").Value = myFile

    summaryWs.Cells(targetRow + 1, "C").Value = myFile

    summaryWs.Cells(targetRow + 2, "C").Value = myFile

     

    '关闭工作簿，不保存更改

    wb.Close SaveChanges:=False

     

    '获取下一个文件

    myFile = Dir

     

    '准备下一行

    targetRow = targetRow + 3

  Loop

End Sub