VBA抓取文件夹下Excel工作簿固定位置的数据汇总到一个工作簿里

Sub a()
  Dim nm As String, filePath As String
  Dim wb As Workbook
  Dim brr(),n,str
  Set wb = ActiveWorkbook
  filePath = wb.Path & "\"
  nm = Dir(filePath & "*.xls*")
  Application.DisplayAlerts = False
  n=1
  redim brr(1 to 100000)
  Do While Len(nm) <> 0
    If nm <> wb.Name Then
        Workbooks.Open filePath & nm
        str= Workbooks(nm).worksheets("Sheet1").[A1]
        if str<>"" then
            brr(n)=str
            n=n+1
        end if
        Workbooks(nm).Close
    End If
    nm = Dir()
  Loop
  wb.worksheets(1).[b1].resize(n-1,1)=application.transpose(brr)
  Application.DisplayAlerts = True
End Sub