未命名新建Worksheet时，如何调整VBA宏实现Sheet1数据追加？

你的核心问题是原代码每次新建工作表却没有保留对它的引用，导致后续无法定位到该表进行追加操作。下面是修改后的代码，同时优化了原代码中依赖Select的不稳定写法：

Sub AppendToTargetWS()
    Dim targetWS As Worksheet
    Dim sourceRange As Range
    Dim lastRow As Long
    
    ' 验证用户选择的是Sheet1中的有效数据区域
    If TypeName(Selection) <> "Range" Then
        MsgBox "请先在Sheet1中选择要追加的数据区域！", vbExclamation
        Exit Sub
    End If
    Set sourceRange = Selection
    If sourceRange.Parent.Name <> "Sheet1" Then
        MsgBox "请在Sheet1中选择数据！", vbExclamation
        Exit Sub
    End If
    
    ' 查找或创建目标工作表（可自行修改工作表名称"目标数据"）
    On Error Resume Next
    Set targetWS = ThisWorkbook.Sheets("目标数据")
    On Error GoTo 0
    
    If targetWS Is Nothing Then
        ' 首次运行：新建工作表并粘贴数据到A1
        Set targetWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        targetWS.Name = "目标数据"
        sourceRange.Copy targetWS.Range("A1")
    Else
        ' 非首次运行：找到目标表最后一行，追加数据到下方
        lastRow = targetWS.Cells(targetWS.Rows.Count, "A").End(xlUp).Row + 1
        sourceRange.Copy targetWS.Range("A" & lastRow)
    End If
    
    Application.CutCopyMode = False
End Sub

关键修改说明 #

• 固定目标工作表标识：给新建的工作表命名为"目标数据"（可自行修改），后续运行宏时会先查找这个表，避免每次新建重复工作表。
• 直接操作对象而非依赖选中状态：原代码的Select和Selection容易因当前激活的工作表变化而出错，修改后用变量targetWS和sourceRange直接操作工作表和数据区域，稳定性更高。
• 自动判断追加逻辑：首次运行时新建工作表并从A1粘贴；后续运行时自动找到目标表的最后一行，将选中的部分数据粘贴到现有数据下方。
• 增加操作验证：确保用户确实在Sheet1中选择了有效数据区域，避免无效操作。

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