求助高手怎么将文件夹中多个Excel表中F列实测面积的汇总数据提取出来放在一个新建的Excel中

Sub test()

Dim FileName As String
Dim r, i As Integer
Dim iSum As Double
Dim Workbook As Workbook
FileName = Dir(ThisWorkbook.Path & "\*.xlsx")

 Do While FileName <> ""

 Set Workbook = Application.Workbooks.Open(ThisWorkbook.Path & "\" & FileName)

 

 With Workbook

  r = .Sheets(1).Cells(Rows.Count, "f").End(xlUp).Row
   iSum = 0
    For i = 4 To r
    iSum = iSum + Sheets(1).Cells(i, "f").Value
    Next
    .Close False
  End With

 

 r = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
  Sheet1.Cells(r, 1) = Left(FileName, Len(FileName) - 5)
  Sheet1.Cells(r, 2).Value = iSum
  

 FileName = Dir

 Loop
End Sub