文件名变更致Excel VBA代码失效，求修改代码适配任意文件名

问题根源 #

原代码硬编码了"File1.xlsx"和"Book1"两个固定文件名，一旦文件改名或切换其他工作簿，代码找不到对应窗口就会触发报错。核心解决思路是用对象变量直接绑定工作簿/工作表，彻底摆脱固定名称依赖，同时取消不必要的Select/Activate操作（这也是VBA高效编写的最佳实践）。

修改后的代码 #

Sub Macro2()
    Dim sourceWb As Workbook
    Dim targetWb As Workbook
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    
    ' 绑定源工作簿（当前运行宏的工作簿）和源工作表
    Set sourceWb = ThisWorkbook
    Set sourceWs = sourceWb.ActiveSheet ' 若需指定固定工作表，可改为sourceWb.Sheets("你的工作表名")
    
    ' 检查是否至少打开两个工作簿
    If Workbooks.Count < 2 Then
        MsgBox "请确保至少打开两个Excel工作簿！"
        Exit Sub
    End If
    
    ' 遍历找到非源工作簿的目标工作簿
    For Each targetWb In Workbooks
        If targetWb.Name <> sourceWb.Name Then
            Set targetWs = targetWb.ActiveSheet ' 同理，可改为targetWb.Sheets("目标工作表名")
            Exit For
        End If
    Next targetWb
    
    ' 批量复制数据，全程无需切换窗口
    With sourceWs
        .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Copy targetWs.Range("A2")
        .Range("C2:C" & .Range("C" & Rows.Count).End(xlUp).Row).Copy targetWs.Range("C2")
        .Range("D2:D" & .Range("D" & Rows.Count).End(xlUp).Row).Copy targetWs.Range("E2")
        .Range("E2:E" & .Range("E" & Rows.Count).End(xlUp).Row).Copy targetWs.Range("F2")
        .Range("F2:F" & .Range("F" & Rows.Count).End(xlUp).Row).Copy targetWs.Range("G2")
    End With
    
    Application.CutCopyMode = False
End Sub

关键改进点 #

• 对象绑定替代固定名称：用sourceWb/targetWb直接引用工作簿，无论文件名怎么改都能正常识别。
• 取消冗余操作：删除所有Select/Activate，直接通过对象复制数据，运行更快且避免窗口切换错误。
• 基础容错处理：添加工作簿数量检查，防止因只打开单个工作簿导致的崩溃。

可选优化：手动选择目标工作簿 #

如果需要更灵活地指定目标文件，可以替换目标工作簿的绑定逻辑为：

Dim targetPath As String
targetPath = Application.GetOpenFilename("Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls")
If targetPath = "False" Then Exit Sub ' 用户取消选择时退出
Set targetWb = Workbooks.Open(targetPath)
Set targetWs = targetWb.ActiveSheet

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