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.发现违规行为请私信站长LAzySheep或进TG群举报。

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

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

2021-6-29 11:51:23

学习笔记

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

2021-7-4 11:12:29

10 条回复 A文章作者 M管理员
  1. YOYO

    喝了你酿的爱情的酒,如果没有续杯,情愿渴一辈子

  2. cuteeee

    很实用

  3. 全

    学习了

  4. 过路人

    混经验升级的

  5. SG

    学到了

  6. cc66528

    学习了

  7. maoqiu5

    这个确实实用

  8. ClegeA

    学到了

  9. 耿耿不寐

    学习啦

  10. yyds

    很实用

个人中心
今日签到
有新私信 私信列表
搜索