VBA遍历文件夹下的文件并且合并工作簿到一个工作簿中

这里整合指把Sheet移动到一个workbook中。
没有覆盖到子文件夹中的文件。


Sub Test()

Debug.Print (ThisWorkbook.Path)

Dim p, stockcode As String
Dim f

p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xlsx") '遍历文件夹下的文件


  Do While f <> ""
        If f <> ThisWorkbook.Name Then
        
        stockcode = Mid(f, 11, 9)
        Debug.Print (p & f)
        Debug.Print (stockcode)
        Workbooks.Open Filename:=p & f 'open
        Sheets("已恢复_Sheet1").Move After:=Workbooks("新建 Microsoft Excel 工作表.xlsm").Sheets(ThisWorkbook.Worksheets.Count) '需要移动到最后一个。这里的Sheet名称全部都是“已恢复_Sheet1”
        
        Sheets("已恢复_Sheet1").Name = stockcode
        'ActiveWorkbook.Close
        
        'Debug.Print (f)
        End If
        f = Dir()
  Loop
  Debug.Print (ThisWorkbook.Worksheets.Count)

End Sub


  • 2
    点赞
  • 3
    评论
  • 17
    收藏
  • 打赏
    打赏
  • 扫一扫,分享海报

评论 3 您还未登录,请先 登录 后发表或查看评论
©️2022 CSDN 皮肤主题:大白 设计师:CSDN官方博客 返回首页

打赏作者

Don Corleone__

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值