求助：如何根据单元格值指定目标工作表并粘贴主表数据？

原代码的问题点 #

• 未检查目标工作表是否存在：若FMASTER表C2单元格的值对应的工作表不存在，代码会直接抛出运行时错误
• 粘贴目标未指定工作表：Range("A1")默认指向当前激活的工作表，而非预期的目标工作表ws
• 缺乏错误处理机制，容错性差

修正后的测试代码 #

Sub TESTT()
    Dim master As Worksheet
    Dim targetWsName As String
    Dim ws As Worksheet
    
    Set master = ThisWorkbook.Worksheets("FMASTER")
    targetWsName = master.Cells(2, 3).Value
    
    ' 检查目标工作表是否存在
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(targetWsName)
    On Error GoTo 0
    
    If ws Is Nothing Then
        MsgBox "工作表 " & targetWsName & " 不存在，请检查C2单元格的值。", vbExclamation
        Exit Sub
    End If
    
    ' 明确指定目标工作表进行粘贴
    master.Range("A2").Copy Destination:=ws.Range("A1")
End Sub

扩展为遍历所有行的完整代码 #

如果要实现遍历FMASTER所有数据行，将对应行数据粘贴到指定工作表的功能，可使用以下代码：

Sub SplitDataToSheets()
    Dim master As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetWsName As String
    Dim ws As Worksheet
    Dim targetLastRow As Long
    
    ' 绑定主数据工作表
    Set master = ThisWorkbook.Worksheets("FMASTER")
    ' 获取主表最后一行（以A列有数据为准，可根据实际调整）
    lastRow = master.Cells(master.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历从第2行开始的所有数据行（假设第1行是表头）
    For i = 2 To lastRow
        targetWsName = master.Cells(i, 3).Value
        
        ' 校验目标工作表是否存在
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(targetWsName)
        On Error GoTo 0
        
        If ws Is Nothing Then
            MsgBox "第" & i & "行对应的工作表 [" & targetWsName & "] 不存在，已跳过该行。", vbExclamation
            GoTo NextRow
        End If
        
        ' 获取目标工作表的最后一行，将数据粘贴到下一行
        targetLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
        
        ' 复制当前整行数据到目标工作表（如需指定列，可改为master.Range("A" & i & ":D" & i)这类格式）
        master.Rows(i).Copy Destination:=ws.Rows(targetLastRow)
        
NextRow:
    Next i
    
    MsgBox "数据拆分完成！", vbInformation
End Sub

核心优化点 #

• 增加工作表存在性校验，避免无意义的运行时错误
• 所有Range对象均明确绑定所属工作表，避免激活工作表带来的逻辑混乱
• 遍历过程中加入错误提示，跳过无效行，保证程序执行完整性
• 动态获取数据最后一行，适配数据量的变化

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