vba合并多个Excel文档

vba合并多个Excel文档

引用自:https://blog.csdn.net/win_turn/article/details/75577465

说明:在引用地址的基础上做了修改,根据公司使用人的需求,把合并sheet页和excel文档揉在了一起。

仅适用于每个sheet的第一行是数据头,数据从第二行开始。

代码:

Sub 合并工作簿()
    Dim FileOpen
    Dim X As Integer
    Application.ScreenUpdating = False
    Rem
    FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xlsx),*.xlsx,
    Excel 97-2003 工作簿(*.xls),*xls", MultiSelect:=True, Title:="请选择需要合并的工作簿")
    X = 1
    If TypeName(FileOpen) = "Boolean" Then
        MsgBox "未选择任何文件, 退出."
        Exit Sub
    End If
    While X <= UBound(FileOpen)
        Workbooks.Open Filename:=FileOpen(X)
        Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        X = X + 1
    Wend
    Dim J As Integer
    On Error Resume Next
    Sheets(1).Select
    Sheets(1).Name = "汇总"
    Sheets(2).Activate
    Sheets(2).Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    For J = 2 To Sheets.Count
        Sheets(J).Activate
        c = Sheets(J).Range("IV1").End(xlToLeft).Column
        r = Sheets(J).Range("A65536").End(xlUp).Row
        Sheets(J).Range("A2").Resize(r - 1, c).Select
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
errhadler:
    MsgBox Err.Description
End Sub
  • 0
    点赞
  • 6
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值