VBA-合并多个工作簿

'合并多个工作薄,并以工作薄的名字给sheet表命名(每个工作薄只有一张表)
Sub test()
Dim str As String
Dim wb As Workbook
str = Dir("C:\Users\Administrator\Desktop\6.3_6.7\*.xls*")
For i = 1 To 100
    Set wb = Workbooks.Open("C:\Users\Administrator\Desktop\6.3_6.7\" & str)
    '文件汇总
    wb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    '使用文件名命名sheet表名,带文件后缀名。
    'ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = wb.Name
   '使用split分隔,实现去掉后缀
   ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0)
   
    wb.Close
    str = Dir
    If str = "" Then
    Exit For
    End If
    
Next

End Sub

 

'一个工作簿有多个sheet表,以sheet表的名字命名
Sub test()
Dim str As String
Dim wb As Workbook
Dim sht As Worksheet
str = Dir("E:\data\*.xls*")
For i = 1 To 100
    Set wb = Workbooks.Open("E:\data\" & str)
    '文件汇总
    For Each sht In wb.Sheets
    sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
   'ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0) & sht.Name
   ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = sht.Name
   Next
   
    wb.Close
    str = Dir
    If str = "" Then
    Exit For
    End If
    
Next

End Sub

 

转载于:https://www.cnblogs.com/pingzizhuanshu/p/11219665.html

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值