EXCEL VBA批量获取excel标题内容并填写到当前文件中
Sub test()
Dim r&, i&
Dim arr, brr
Dim wba As Workbook
Dim wsa As Worksheet
Set wba = ThisWorkbook
Set wsa = wba.Worksheets(1)
'wsa.Range("b1:GY21").Clear
wsa.Range("A2:GY21").Clear
Dim namenum As Integer
namenum = 2 '从第二行开始
Dim wb As Workbook
Dim ws As Worksheet
Dim mypath$, myname$
Dim csvcount
Dim sumproduct
Dim unull
Dim zhushicishu
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mypath = ThisWorkbook.Path & "\原始数据存放\"
myname = Dir(mypath & "*.*")
Randomize Timer
csvcount = 0
Application.DisplayAlerts = False
Application.ScreenUpdating = False
j = 65
Do While myname <> ""
Set wb = GetObject(mypath & myname)
Windows(wb.Name).Visible = True
sumproduct = 0
With wb
With .Worksheets(1)
wsa.Cells(namenum, 1) = myname
For i = 1 To 200
If wb.Worksheets(1).Cells(1, i) <> "" Then
If (i + 64) <= 90 Then
wsa.Cells(1, i + 1) = Chr(i + 64)
Else
wsa.Cells(1, i + 1) = Chr(65) & Chr(j)
j = j + 1
End If
wsa.Cells(namenum, i + 1) = Trim(wb.Worksheets(1).Cells(1, i))
Else
Exit For
End If
Next i
namenum = namenum + 1
End With
.Close True
End With
myname = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "数据写入完毕!"
End Sub