工作簿合并(Excel代码集团)

同一文件夹内N个工作簿 ,每个工作簿里N个工作表,最终合并到一个工作表里的代码。

假设每个表格结构相同,第一行为标题,第二行为表头,表头内容固定,行数不固定,列固定14,工作表数量不固定,工作簿数量不固定。

Sub Sample()
Dim MyWb As Workbook
Dim MySht As Worksheet
Dim MyName As String, MyPath As String
Dim MyRow As Long, MySRow As Long, MyShtN As Long
Dim MyArr
MyPath = ThisWorkbook.Path & ""
MyName = Dir(MyPath & "*.xlsx")
With ActiveSheet
    .Cells.Clear
    .Range("a1") = "标题" '根据实际需要自行修改
    .Range("a2:n2") = "表头" '根据实际需要自行修改
    Do While MyName <> ""
        If MyName <> ThisWorkbook.Name Then
            Set MyWb = Workbooks.Open(MyPath & MyName)
            For MyShtN = 1 To Sheets.Count
                MySRow = .Cells(Rows.Count, 1).End(xlUp).Row
                MyRow = Cells(Rows.Count, 1).End(xlUp).Row
                MyArr = Sheets(MyShtN).Range("a3").Resize(MyRow - 2, 14)
                .Cells(MySRow + 1, 1).Resize(MyRow - 2, 14) = MyArr
            Next
            MyWb.Close False
        End If
        MyName = Dir
    Loop
    With .UsedRange
        .Columns.AutoFit
        .Borders.Color = 1
    End With
End With
End Sub
原博客各种作……所以换阵地了,不过每篇都搬过来,实在有点累,想看就自己看吧:http://blog.sina.com.cn/pureiceshadow
原文地址:https://www.cnblogs.com/officeplayer/p/11028941.html