使用VBA循环将多列数据从指定工作簿批量复制到新建工作簿

需求说明 #

已打开Test_Me21.xlsm（运行代码的工作簿）和Loading.xlsx，需要循环完成以下批量操作：

• 新建工作簿，将Loading.xlsx的某一列（从A列开始，依次处理B、C列等）复制到新工作簿的B列
• 把新工作簿重命名为其B1单元格的内容
• 无提示保存到指定文件夹后关闭工作簿

原代码存在的问题 #

原代码仅处理了A列，没有实现循环逻辑，且依赖ActiveWorkbook这类不稳定的引用方式，保存命名的逻辑也没正确关联到新工作簿的B1值。

修正后的完整VBA代码 #

Sub CopyDataIntoBooks()
    Dim wbLoading As Workbook
    Dim wbNew As Workbook
    Dim wsLoading As Worksheet
    Dim lastCol As Integer
    Dim col As Integer
    Dim savePath As String
    
    ' 指定保存路径（根据实际情况修改）
    savePath = "C:\users\myname\Documents\Planning\Loading Background work\"
    
    ' 引用已打开的Loading.xlsx和其Sheet1
    Set wbLoading = Workbooks("Loading.xlsx")
    Set wsLoading = wbLoading.Worksheets("Sheet1")
    
    ' 获取Loading.xlsx中最后一列有数据的列号
    lastCol = wsLoading.Cells(1, wsLoading.Columns.Count).End(xlToLeft).Column
    
    ' 循环处理每一列（从A列到最后一列）
    For col = 1 To lastCol
        ' 新建工作簿
        Set wbNew = Workbooks.Add
        
        ' 复制当前列的数据到新工作簿的B列（保留格式和值）
        wsLoading.Columns(col).Copy Destination:=wbNew.Worksheets(1).Range("B1")
        
        ' 获取新工作簿B1的值作为文件名
        Dim newFileName As String
        newFileName = wbNew.Worksheets(1).Range("B1").Value
        
        ' 避免文件名非法字符（可选，防止报错）
        newFileName = Replace(newFileName, "/", "-")
        newFileName = Replace(newFileName, "\", "-")
        newFileName = Replace(newFileName, ":", "-")
        newFileName = Replace(newFileName, "*", "-")
        newFileName = Replace(newFileName, "?", "-")
        newFileName = Replace(newFileName, """", "-")
        newFileName = Replace(newFileName, "<", "-")
        newFileName = Replace(newFileName, ">", "-")
        newFileName = Replace(newFileName, "|", "-")
        
        ' 无提示保存新工作簿
        wbNew.SaveAs Filename:=savePath & newFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        
        ' 关闭新工作簿
        wbNew.Close SaveChanges:=False
    Next col
    
    MsgBox "批量操作完成！"
End Sub

代码关键说明 #

• 用wbLoading、wbNew这类变量直接引用工作簿，避免ActiveWorkbook带来的不稳定问题
• 自动获取Loading.xlsx的最后一列，无需手动指定列数
• 复制整列数据，不用固定A1:A7这类范围，适配不同数据量
• 增加了非法字符替换，防止文件名无效导致保存失败
• 全程无提示保存，符合需求

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