EXCEL VBA批量获取excel标题内容并填写到当前文件中

Sub test()Dim r&, i&Dim arr, brrDim wba As WorkbookDim wsa As WorksheetSet wba = ThisWorkbookSet wsa = wba.Worksheets(1)'wsa.Range("b1:GY21").Clearwsa.Range("A2:GY21").ClearDim namenum As Integernamenum = 2 '从第二行开始Dim wb As WorkbookDim ws As WorksheetDim mypath$, myname$Dim csvcountDim sumproductDim unullDim zhushicishuApplication.ScreenUpdating = FalseApplication.DisplayAlerts = Falsemypath = ThisWorkbook.Path & "\原始数据存放\"myname = Dir(mypath & "*.*")Randomize Timercsvcount = 0Application.DisplayAlerts = FalseApplication.ScreenUpdating = Falsej = 65Do While myname <> ""Set wb = GetObject(mypath & myname)Windows(wb.Name).Visible = Truesumproduct = 0With wbWith .Worksheets(1)wsa.Cells(namenum, 1) = mynameFor i = 1 To 200If wb.Worksheets(1).Cells(1, i) <> "" ThenIf (i + 64) <= 90 Thenwsa.Cells(1, i + 1) = Chr(i + 64)Elsewsa.Cells(1, i + 1) = Chr(65) & Chr(j)j = j + 1End Ifwsa.Cells(namenum, i + 1) = Trim(wb.Worksheets(1).Cells(1, i))ElseExit ForEnd IfNext inamenum = namenum + 1End With.Close TrueEnd Withmyname = DirLoop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "数据写入完毕！"
End Sub