如何通过VBA宏将源工作簿指定列按序复制到新Excel文件

现有一段VBA宏代码已能触发新Excel文件的保存对话框，需补充功能实现：读取运行宏的活动工作簿中B2:B5指定的列顺序、B6的源工作簿路径，打开源工作簿后按指定顺序复制对应列到新文件并完成保存。

示例效果 #

• 源工作簿：包含A、B、C、D四列数据
• 活动工作簿配置：B2:B5依次填入D、A、C、B，B6填入源工作簿的完整路径
• 执行宏后：新保存文件的列顺序为「源工作簿D列 → A列 → C列 → B列」

完善后的VBA代码 #

Sub test_this()
    Dim sFileSaveName As Variant, cel As Range
    Dim InitialName As String, column_name As String
    Dim NextColumn As Long, sourcePath As String
    
    Dim wbSource As Workbook, wbDestin As Workbook
    Dim wsSource As Worksheet, wsDestin As Worksheet, wsControl As Worksheet
    
    ' 指向运行宏的活动工作簿（配置表所在）
    Set wsControl = ActiveSheet
    ' 读取源工作簿路径
    sourcePath = wsControl.Range("B6").Value
    
    ' 验证路径有效性，避免报错
    If Dir(sourcePath) = "" Then
        MsgBox "源工作簿路径无效，请检查B6单元格内容！", vbExclamation
        Exit Sub
    End If
    
    ' 后台打开源工作簿，关闭屏幕更新提升效率
    Application.ScreenUpdating = False
    Set wbSource = Workbooks.Open(Filename:=sourcePath, ReadOnly:=True)
    Set wsSource = wbSource.Worksheets("Sheet1") ' 源数据所在工作表，可按需修改
    
    ' 触发保存对话框，指定xlsm格式
    InitialName = "Sample Output"
    sFileSaveName = Application.GetSaveAsFilename( _
        InitialFileName:=InitialName, _
        fileFilter:="Excel Files (*.xlsm), *.xlsm")
    
    If sFileSaveName <> False Then
        ' 创建新工作簿作为目标文件
        Set wbDestin = Workbooks.Add
        Set wsDestin = wbDestin.Worksheets(1)
        
        NextColumn = 1 ' 目标文件起始列
        
        ' 遍历配置的列名，按顺序复制
        For Each cel In wsControl.Range("B2:B5")
            column_name = cel.Value
            ' 复制对应列到目标文件
            On Error Resume Next
            wsSource.Columns(column_name).Copy Destination:=wsDestin.Columns(NextColumn)
            On Error GoTo 0
            
            NextColumn = NextColumn + 1
        Next cel
        
        ' 保存并关闭目标工作簿
        wbDestin.SaveAs Filename:=sFileSaveName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        wbDestin.Close SaveChanges:=False
    End If
    
    ' 收尾：关闭源工作簿，恢复屏幕更新
    wbSource.Close SaveChanges:=False
    Application.ScreenUpdating = True
    MsgBox "操作完成！", vbInformation
End Sub

关键逻辑说明 #

• 路径校验：先检查B6的源路径是否存在，避免无效路径导致运行报错
• 后台操作：关闭屏幕更新，减少界面闪烁同时提升运行速度
• 列复制逻辑：遍历B2:B5的列名，自动匹配源工作簿对应列并复制到目标文件的指定位置
• 格式兼容：默认保存为xlsm格式，若不需要宏支持可修改为xlOpenXMLWorkbook（对应xlsx格式）

内容的提问来源于stack exchange，提问作者Hello Apple