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

最新推荐文章于 2024-08-20 17:04:37 发布

小超人_L

最新推荐文章于 2024-08-20 17:04:37 发布

阅读量2.7w

点赞数 6

分类专栏： VBA 文章标签： VBA

本文链接：https://blog.csdn.net/Milong_xiao/article/details/79069341

版权

VBA 专栏收录该内容

2 篇文章 1 订阅

订阅专栏

'**************************************************************************************
'获取一个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