Sub 汇总数据()

Application.ScreenUpdating = False

p = "d:\\提取\\"

f = Dir(p & "*.xlsx")

Do While f <> "" （提示这里是错误的：没有结束语）

Workbooks.Open p & f

r = r + 1

ActiveSheet.Rows(3).Copy

Workbooks("汇总.xlsx").Sheets("sheet1").Activate
ActiveSheet.Range("A" & r).Select
ActiveSheet.Paste
Application.CutCopyMode = xlCut
Workbooks(f).Activate
ActiveWorkbook.Saved = True

ActiveWindow.Close

f = Dir

Loop

Application.ScreenUpdating = True
End Sub

Dim xlApp As Object
Dim xlApp2 As Object
Dim xlBook As Object
Dim xlBook2 As Object

f = Dir("*.xlsx")
fPath = App.Path

Set xlApp = CreateObject("Excel.Application")
Set xlApp2 = CreateObject("Excel.Application")


xlApp.Visible = True
xlApp2.Visible = True



Set xlBook2 = xlApp2.Workbooks.Add
xlBook2.SaveAs fPath & "\汇总.xlsx"





startrow = 1
endrow = 4
incolumns = 2

outC = 1

Do While f <> ""
   Set xlBook = xlApp.Workbooks.Open(fPath & "\" & f)
   
   outR = 1
   For r = startrow To endrow
       s = xlBook.ActiveSheet.Cells(r, incolumns)
        xlBook2.ActiveSheet.Cells(outR, outC) = s
        outR = outR + 1
   Next
   
   outC = outC + 1
   xlBook.Close
    f = Dir
Loop


xlBook2.Save
xlApp2.Quit
xlApp.Quit