VBA 合并多个excel

最新推荐文章于 2024-11-05 09:11:29 发布

Ctrain

最新推荐文章于 2024-11-05 09:11:29 发布

阅读量1.1k

点赞数 1

CC 4.0 BY-SA版权

分类专栏：工具文章标签： vba

本文链接：https://blog.youkuaiyun.com/Ctrain/article/details/51265190

工具专栏收录该内容

21 篇文章

订阅专栏

本文介绍了一段VBA代码，用于自动从多个Excel文件中提取“附表一之二纳税主体”工作表的数据，并汇总到一个目标Excel文件中。该过程包括打开源文件、定位特定工作表、复制数据并粘贴到目标文件等步骤。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Sub 汇总()

   Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   myPath = ThisWorkbook.Path & "\VMS基础信息表（寿险汇总）\"          '把文件路径定义给变量

   myFile = Dir(myPath & "*.xlsx")            '依次找寻指定路径中的*.xls文件
   Do While myFile <> ""                     '当指定路径中有文件时进行循环
      If myFile <> ThisWorkbook.Name Then
         Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
          For i = 1 To AK.Sheets.Count
         If AK.Sheets(i).Name = "附表一之二 纳税主体" Then
         aRow = AK.Sheets(3).Range("b65536").End(xlUp).Row
         tRow = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row + 1

            'AK.Sheets(i).Select
         AK.Sheets(3).Range("A8:r" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
         End If
         Next
         Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
      End If
      myFile = Dir                                   '找寻下一个*.xls文件
   Loop

   Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
   MsgBox "汇总完成，请查看！", 64, "提示"


End Sub