宏处理将多个excel文件的指定sheet页合并到一个excel文件中

背景了解:有个同事问我:现在他要处理一千多个文件,每个excel文件都有3个sheet页签,想把所有的excel文件的第二个sheet页签复制一份放到一个新的excel文件中。如果是手动去操作一个个文件的复制,也没什么不可,就是有点费手。像这种大批量的对文件做相同的操作,肯定会有更简便的方法替代,这样我们就可以把更多的精力放在具体的业务处理上了。

提前了解:

1.VB宏是什么?

VB(Visual Basic)宏是一种在 Microsoft Office 应用程序(如 Excel、Word、Access 等)中使用的自动化脚本。这些宏允许用户编写 VBA(Visual Basic for Applications)代码来自动化任务,提高工作效率。VBA 是 Visual Basic 的一个子集,专门用于 Office 应用程序的自动化。

2.VB宏的特点

  • 自动化任务:宏可以自动执行一系列操作,如数据处理、格式化、文件操作等。
  • 用户界面:宏可以通过按钮、菜单项或其他用户界面元素触发。
  • 事件驱动:宏可以响应用户操作或特定事件(如工作表更改、工作簿打开等)。
  • 丰富的库支持:VBA 提供了大量的内置对象和方法,可以方便地操作 Office 应用程序的各种功能。

3.环境准备

需要先有下图工具:版本不限

4.操作步骤

4.1新建空文件

创建一个新的空的excel文件,用来存储最终结果的文件,记住该文件的路径,并用上述excel工具打开文件:如下为空文件

4.2创建宏

找到开发工具:

然后再找到VB编辑器:

进入如下VB编辑器页面,只要能进入编辑器页面就可以,有部分软件的进入方式可能不同:

然后插入一个模块:

在下方空白弹窗出加入以下代码:

Sub CopySheetsFromFolder()
    Dim srcFolder As String
    Dim dstWorkbook As Workbook
    Dim srcWorkbook As Workbook
    Dim fileName As String
    Dim ws As Worksheet

    ' 指定源文件夹路径,重点:需要修改
    srcFolder = "C:\Users\123456\Desktop\"
    ' 请替换为实际的文件夹路径

    ' 打开目标工作簿,重点:一个新的空的xlsx文件的全路径名称
    On Error Resume Next
    Set dstWorkbook = Workbooks.Open("C:\Users\123456\Desktop\ceshi.xlsx")
    On Error GoTo 0
    If dstWorkbook Is Nothing Then
        MsgBox "无法打开目标工作簿 ceshi.xlsx", vbCritical
        Exit Sub
    End If

    ' 获取文件夹中的第一个 .xlsx 文件
    fileName = Dir(srcFolder & "*.xlsx")

    ' 遍历文件夹中的所有 .xlsx 文件
    Do While fileName <> ""
        ' 打开源文件
        On Error Resume Next
        Set srcWorkbook = Workbooks.Open(srcFolder & fileName)
        On Error GoTo 0
        If srcWorkbook Is Nothing Then
            MsgBox "无法打开文件 " & srcFolder & fileName, vbCritical
            GoTo NextFile
        End If

        ' 检查源文件是否有至少2个工作表:重点:想要合并的sheet页签为第几个sheet
        If srcWorkbook.Sheets.Count >= 2 Then
            ' 获取第二个工作表,重点:sheet(23)为sheet页签的名称
            Set ws = srcWorkbook.Sheets(23)

            ' 将第二个工作表复制到目标工作簿的最后一个工作表之后
            ws.Copy After:=dstWorkbook.Sheets(dstWorkbook.Sheets.Count)
        Else
            MsgBox "文件 " & fileName & " 不包含第二个工作表", vbExclamation
        End If

        ' 关闭源文件
        srcWorkbook.Close SaveChanges:=False

NextFile:
        ' 获取下一个文件
        fileName = Dir
    Loop

    ' 提示完成
    MsgBox "所有文件的第二个工作表已成功复制到 ceshi.xlsx", vbInformation
End Sub

4.3运行宏

然后运行代码:

运行完后,查看刚刚新建的文件即可得到结果。

猜你喜欢

转载自blog.csdn.net/weixin_57259781/article/details/143330554