MSCBSC 移动通信论坛
搜索
登录注册
网络优化工程师招聘专栏 4G/LTE通信工程师最新职位列表 通信实习生/应届生招聘职位
 

  • 阅读:516
  • 回复:1
多张表格快速合并一张表格
程武建
新手上路
鎵嬫満鍙风爜宸查獙璇


 发短消息    关注Ta 

积分 -864
帖子 6
威望 2871 个
礼品券 0 个
专家指数 -894
注册 2017-3-20
专业方向 
回答问题数 0
回答被采纳数 0
回答采纳率 0%
 
发表于 2022-04-14 09:29:47  只看楼主 

Sub 合并目录所有工作簿全部工作表()

Dim MP, MN, AW, Wbn, wn

Dim Wb As Workbook

Dim i, a, b, d, c, e

Application.ScreenUpdating = False

MP = ActiveWorkbook.Path

MN = Dir(MP & "" & "*.xls")

AW = ActiveWorkbook.Name

Num = 0

e = 1

Do While MN <> ""

If MN <> AW Then

Set Wb = Workbooks.Open(MP & "" & MN)

a = a + 1

With Workbooks(1).ActiveSheet

For i = 1 To Sheets.Count

If Sheets(i).Range("a1") <> "" Then

Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)

d = Wb.Sheets(i).UsedRange.Columns.Count

c = Wb.Sheets(i).UsedRange.Rows.Count - 1

wn = Wb.Sheets(i).Name

.Cells(1, d + 1) = "表名"

.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn

e = e + c

Wb.Sheets(i).Range("a2").Resize(c,d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)

End If

Next

Wbn = Wbn & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MN = Dir

Loop

Range("a1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & a & "个工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示"

End Sub

 


扫码关注5G通信官方公众号,免费领取以下5G精品资料
  • 1、回复“iot6”免费领取《【8月30号登载】物联网创新技术与产业应用蓝皮书——物联网感知技术及系统应用
  • 2、回复“6G31”免费领取《基于云网融合的6G关键技术白皮书
  • 3、回复“IM6G”免费领取《6G典型场景和关键能力白皮书
  • 4、回复“SPN2”免费领取《中国移动SPN2.0技术白皮书
  • 5、回复“LTKJ7”免费领取《 联通科技周17本白皮书合集
  • 6、回复“5g-a”免费领取《中国联通5G-A 通感算融合技术白皮书
  • 7、回复“URLLC”免费领取《中国联通5G URLLC 技术白皮书
  • 8、回复“LDSL”免费领取《中国移动算力网络技术白皮书
  • 对本帖内容的看法? 我要点评


    作者的更多帖子
     
    [充值威望,立即自动到帐] [VIP贵宾权限+威望套餐] 另有大量优惠赠送活动,请光临充值中心
    充值拥有大量的威望和最高的下载权限,下载站内资料无忧

    快速回复主题    
    标题
    内容
     上传资料请点左侧【添加附件】

    当前时区 GMT+8, 现在时间是 2024-03-29 19:14:32
    渝ICP备11001752号  Copyright @ 2006-2016 mscbsc.com  本站统一服务邮箱:mscbsc@163.com

    Processed in 0.272700 second(s), 13 queries , Gzip enabled
    TOP
    清除 Cookies - 联系我们 - 移动通信网 - 移动通信论坛 - 通信招聘网 - Archiver