Excel VBA：激活新另存工作簿并解决跨工作簿复制范围异常问题

核心问题 #

1. 对象绑定错误：你代码里的wsPubBrand是绑定到运行此宏的原工作簿的工作表，而非刚创建的新工作簿，所以复制的是原工作簿内容，不是新工作簿里的目标范围。
2. 依赖Active对象：过度使用ActiveWorkbook/ActiveSheet，这类对象会因操作变化而改变，导致引用混乱。
3. 变量未显式声明：DataWSheet、BranchField等变量未声明，容易引发隐式绑定错误。

修正后的代码 #

Sub SaveAsWorkbookWNewName()
    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
    Dim DataWSheet      As Worksheet ' 显式声明
    Dim BranchField     As Range     ' 显式声明
    Dim wsPubBrand      As Worksheet ' 显式声明
    Dim BranchName      As Variant
    Dim NewWSheet       As Worksheet
    
    ' 绑定原工作簿的数据源工作表
    Set DataWSheet = ThisWorkbook.Worksheets("Pub list")
    Set BranchField = DataWSheet.Range("C12", DataWSheet.Range("C12").End(xlDown))
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    FPath = "C:PATH\Pubs"

    For Each BranchName In BranchField
        ' 打开模板并赋值给变量，避免依赖ActiveWorkbook
        Set NewBook = Workbooks.Open("C:PATH/workbook")
        
        FName = BranchName & ".xlsm"
        NewBook.SaveAs Filename:=FPath & "\" & FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        
        ' 新建工作表并命名
        Set NewWSheet = NewBook.Sheets.Add(After:=NewBook.Sheets(NewBook.Sheets.Count))
        NewWSheet.Name = BranchName
        
        ' 绑定新工作簿里的目标工作表（替换成你实际要复制的工作表名）
        Set wsPubBrand = NewBook.Worksheets("Pub brand schedule one page")
        ' 将新建工作表名称写入目标单元格
        wsPubBrand.Range("C5").Value = NewWSheet.Name
        ' 从新工作簿的目标工作表复制到新建工作表
        wsPubBrand.Range("A1:EJ64").Copy Destination:=NewWSheet.Range("A1:EJ64")
        
        NewBook.Save
        NewBook.Close ' 处理完后关闭新工作簿，避免打开过多文件
    Next BranchName

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

关键改动说明 #

• 全程使用变量引用：用NewBook替代ActiveWorkbook，确保始终操作的是刚创建的新工作簿，避免对象引用混乱。
• 显式声明所有变量：避免隐式类型转换和绑定错误，同时让代码更易读。
• 正确绑定工作表：wsPubBrand现在绑定到NewBook（新工作簿）里的对应工作表，而不是原工作簿。
• 添加关闭工作簿操作：循环里处理完每个分支后关闭新工作簿，防止打开过多文件导致性能问题。

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