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列（这里类似转置）
Application.ScreenUpdating = True
*************************************************
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(ThisWorkbook.Path & "/导入.xls") '打开一个Excel文件
Set ws = wk.Worksheets(1) '打开的workbook中的第一个worksheet
For i = 1 To 30 Step 1 '循环worksheet
Set ThisWs = ThisWorkbook.Worksheets(1)
ThisColCount = ThisWs.UsedRange.Columns.Count
ws.Cells(i, 1) = ThisWs.Name '将第一列第i行的单元格赋值为当前worksheet的sheet name.
For j = 1 To ThisColCount Step 1 '循环columns
ws.Cells(i, j + 1) = ThisWs.Cells(1, j) '将当前worksheet的第一行第j列单元格的值赋值给ws 的第j+1行第i列（这里类似转置）
Next j
Next i
wk.Close
Application.ScreenUpdating = True
End Sub
