如何让VBA宏适配可变工作簿/工作表名称？代码修改求助

我来帮你搞定这个需求！你已经通过单元格路径成功打开了目标工作簿，接下来只需要把硬编码的名称替换成从「Macro」工作表读取的单元格值，就能实现动态引用，以后名称变更时直接修改单元格内容即可，无需改动代码。

修改后的完整代码 #

Sub CopySurveyData()
    Dim survey As Workbook
    Dim wsMacro As Worksheet
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
    ' 定义存储配置信息的变量
    Dim surveyPath As String
    Dim surveyFileName As String
    Dim sourceSheetName As String
    Dim targetSheetName As String
    
    ' 先获取「Macro」工作表的引用，避免重复查找
    Set wsMacro = ThisWorkbook.Worksheets("Macro")
    
    ' 从Macro工作表读取配置信息（可根据你的实际单元格位置调整）
    surveyPath = wsMacro.Range("B5").Value
    surveyFileName = wsMacro.Range("B6").Value
    sourceSheetName = wsMacro.Range("B7").Value ' 存储要复制的工作表名（比如原Sheet1）
    targetSheetName = wsMacro.Range("B8").Value ' 存储目标工作表名（比如原Survey Answers）
    
    ' 打开指定路径的工作簿
    Set survey = Workbooks.Open(Filename:=surveyPath & "\" & surveyFileName)
    
    ' 动态设置源工作表（来自打开的survey工作簿）
    Set wsCopy = survey.Worksheets(sourceSheetName)
    
    ' 动态设置目标工作表（来自当前运行宏的工作簿，即Master Worksheet.xlsm）
    Set wsDest = ThisWorkbook.Worksheets(targetSheetName)
    
    ' 获取源数据最后一行
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
    ' 获取目标区域的第一个空行
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
    
    ' 复制并粘贴指定范围的数据
    wsCopy.Range("J3:AQ" & lCopyLastRow).Copy _
        wsDest.Range("A" & lDestLastRow)
    
    ' 关闭survey工作簿并保存
    survey.Close SaveChanges:=True
    
    ' 释放对象变量（良好的编程习惯）
    Set wsDest = Nothing
    Set wsCopy = Nothing
    Set survey = Nothing
    Set wsMacro = Nothing
End Sub

关键修改说明 #

1. 动态读取配置：新增从「Macro」工作表读取源/目标工作表名称的逻辑，对应代码中的sourceSheetName和targetSheetName变量，你可以根据自己的需求调整存储这些名称的单元格（比如把B7/B8换成其他位置）。
2. 用ThisWorkbook指代当前工作簿：代替硬编码的Workbooks("Master Worksheet.xlsm")，这样即使你重命名了Master工作簿，代码依然能正确找到目标工作表。
3. 直接用对象关闭工作簿：原来的Workbooks("Workbook1.xlsx").Close改成survey.Close，因为survey就是你通过单元格路径打开的工作簿对象，不管文件名怎么变都能正确关闭。

可选的健壮性优化 #

为了避免因单元格内容填写错误（比如工作表名拼写错）导致代码崩溃，你可以加入错误检查逻辑：

' 检查源工作表是否存在
On Error Resume Next
Set wsCopy = survey.Worksheets(sourceSheetName)
On Error GoTo 0
If wsCopy Is Nothing Then
    MsgBox "错误：源工作表「" & sourceSheetName & "」不存在！", vbExclamation
    survey.Close SaveChanges:=False
    Exit Sub
End If

' 检查目标工作表是否存在
On Error Resume Next
Set wsDest = ThisWorkbook.Worksheets(targetSheetName)
On Error GoTo 0
If wsDest Is Nothing Then
    MsgBox "错误：目标工作表「" & targetSheetName & "」不存在！", vbExclamation
    survey.Close SaveChanges:=False
    Exit Sub
End If

把这段代码放在Set survey = Workbooks.Open(...)之后，就能在出错时弹出提示并安全退出。

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