Excel使用宏VBA在新建的工作簿中汇总罗列(复制粘贴)同一文件夹下不同工作簿中某一工作表的同一区域数据。

一、按住 ALT + F11 键打开 Microsoft Visual Basic应用程序 窗口。

二、点击 插页 > 模块,然后将以下代码粘贴到 模块 窗口。

Sub Request()
Dim Mypath, MyName
Filename1 = ThisWorkbook.Sheets("工作表名称").Cells(1, 5).Value
Mypath = ThisWorkbook.Path & "\"    ' 指定路径。
MyName = Dir(Mypath, vbDirectory)   '文件名称

Application.ScreenUpdating = False
Do While MyName <> ""  '遍历所有上报的excel
    If MyName <> "." And MyName <> ".." And (MyName Like "*工作簿名称相同关键字*.xls" Or MyName Like "*工作簿名称相同关键字*.xlsx") Then
         'ThisWorkbook.Sheets("工作表名称").Select
        For i = 2 To 300
            If ThisWorkbook.Sheets("工作表名称").Cells(2, i) <> "" And MyName Like "*" & ThisWorkbook.Sheets("工作表名称").Cells(2, i) & "*" Then
                Debug.Print Cells(2, i)
                Set openfile = Workbooks.Open(Mypath + MyName) '打开单个excel
                
                
                '第一次copy
                Workbooks(MyName).Activate
                Range("E" & 4, "H" & 7).Copy
               
                Workbooks(Filename1).Activate
                Range(Cells(4, i + 1), Cells(7, i + 4)).Select
                
                Selection.PasteSpecial Paste:=xlPasteValues
                '第二次copy
                Workbooks(MyName).Activate
                Range("E" & 10, "H" & 13).Copy
                Workbooks(Filename1).Activate
                Range(Cells(10, i + 1), Cells(13, i + 4)).Select
                Selection.PasteSpecial Paste:=xlPasteValues
                
                 '第三次copy
                Workbooks(MyName).Activate
                Range("D" & 9, "D" & 9).Copy
                Workbooks(Filename1).Activate
                Range(Cells(9, i), Cells(9, i)).Select
                Selection.PasteSpecial Paste:=xlPasteValues
                
                'Debug.Print Cells(2, i)
                '循环后检查,是否还有excel打开状态
                Set MyExcel = GetObject(, "Excel.Application")
                For Each axls In MyExcel.Workbooks
                If InStr(1, axls.Name, MyName, 1) Then
                Workbooks(MyName).Close False
                End If
                Next
            End If
        Next
       
    End If
    MyName = Dir
Loop
Application.ScreenUpdating = True
End Sub


三、按住 ALT + F8,快捷唤出模块。

-> 加入科技玩家交流群组:点击加入 <-
注意:
1.文中二维码和链接可能带有邀请性质,请各位玩家自行抉择。
2.请勿通过链接填写qq号与密码、银行卡号与密码等个人隐私信息。
3.禁止纯拉人头,拉app注册等信息,发现必小黑屋。
4.同一种信息仅发一次,多发会被删除。
5.文章中源码或APP等,无法保证其绝对安全,需自行辨别。
6.文章关联方不想展示也可以微信站长“socutesheep”删除。

给TA买糖
共{{data.count}}人
人已买糖
Office学习笔记

Excel使用宏VBA汇总罗列在同一工作簿中不同工作表同一区域的数据

2021-6-29 11:51:23

学习笔记精选文章

如何优雅地修改你的支付宝/微信运动步数?8.12更新

2021-7-4 11:12:29

34 条回复 A文章作者 M管理员
贴心提醒
请认真对待作者付出,勿发表无意义言论,触发过滤规则的评论将无法提交,包含敏感词的评论会自动变成待审核状态哦。
  1. Jlzhong

    学习了

  2. 衍

    学习了

  3. 梵高先生

    学习了

  4. 两个空格

    谢谢分享,学习了

  5. 止一世迷离

    非常不错。

  6.  22333

    学到了

  7. 网络中心

    看看看😁

  8. xiaoxuanfeng

    学习一下!

  9. xegpt

    学习了,想不到excel还能这么用

  10. 萝卜头

    谢谢,分享学习了

  11. slimei

    这真是个好文章,谢谢

  12. 这把看我表演

    谢谢分享,学习了

  13. wiusexy

    学习了

个人中心
购物车
优惠劵
今日签到
有新私信 私信列表
搜索