[已解决]多个excel合并成一个excel，在线等

victory610

有多个结构相同的excel，需要合并成一个excel，求VBA代码。谢谢。

最佳答案

月排行榜 / 总排行榜

爱疯

2015-11-12 21:14

http://www.excelpx.com/thread-335471-1-1.html

这工具没做完，不过可以完成现在的需求

跳转到最佳答案楼层

爱疯

http://www.excelpx.com/thread-335471-1-1.html

这工具没做完，不过可以完成现在的需求

lichuanboy44

Sub 数据汇总()
    Application.ScreenUpdating = False
    Dim arr数据
    Dim s行 As Integer
    Set wk汇总 = Worksheets(1)
    Filename = Dir(ThisWorkbook.Path & "\*.xls")
    Do While Filename <> ""
        If Filename <> ThisWorkbook.Name Then
            fn = ThisWorkbook.Path & "\" & Filename
            Set wb = Workbooks.Open(fn)
            Set Sht = wb.Worksheets(1)
            j = Sht.Range("B65536").End(xlUp).Row
            h末列 = Sht.UsedRange.Columns.Count
            s单位 = Left(wb.Name, 4)
            arr数据 = wb.Worksheets(1).Range(Cells(2, 1), Cells(j, h末列))
            s行 = wk汇总.Range("B65536").End(xlUp).Row
            wk汇总.Range("A" & s行 + 1).Resize(j - 1, h末列) = arr数据
            wb.Close False
        End If
        Filename = Dir
        wkcount = wkcount + 1
    Loop
    Application.ScreenUpdating = True
End Sub

lichuanboy44

本论坛上经常问到这个问题，我根据论坛上的代码改编的。我也经常遇到这方面的问题，有点经验。

victory610

非常感谢2楼和3楼的精彩回答，各有千秋，3楼汇总后为什么没有标题行呢。2楼的解答很系统，但是我看不懂哈。