VBA 读取一个Excel文件中的所有worksheet第一行到另一个Excel文件中

'**************************************************************************************
'获取一个Excel文件中的所有worksheet中的第一行的数据到指定文件，指定文件第一行为
'worksheet name，第二行开始为worksheet中的第一行的列名
'*************************************************************************************
Sub ColloctColumn()
Dim wk As Workbook           '目标文件
Dim ws As Worksheet          '目标文件中的目标worksheet
Dim ThisWs As Worksheet      '当前文件
Dim ThisAllSheets As Integer '当前文件中worksheet的总和
Dim ThisColCount As Integer  '当前文件的总列数
Application.ScreenUpdating = False
ThisAllSheets = ThisWorkbook.Sheets.Count
Set wk = Application.Workbooks.Open("D:\all.xlsx")   '打开一个Excel文件
Set ws = wk.Worksheets(1)           '打开的workbook中的第一个worksheet
For i = 1 To ThisAllSheets Step 1   '循环worksheet
Set ThisWs = ThisWorkbook.Worksheets(i)
ThisColCount = ThisWs.UsedRange.Columns.Count
ws.Cells(1, i) = ThisWs.Name                '将第一行第i列的单元格赋值为当前worksheet的sheet name.
For j = 1 To ThisColCount Step 1            '循环columns
ws.Cells(j + 1, i) = ThisWs.Cells(1, j) '将当前worksheet的第一行第j列单元格的值赋值给ws 的第j+1行第i列（这里类似转置）
Next j
Next i
wk.Close
Application.ScreenUpdating = True
End Sub