VBA需求：将数据传递至Data工作表且不覆盖已有数据（附现有代码）

现有宏已实现根据用户输入打开对应班级工作表，下面是修改后的完整代码，新增数据追加功能，确保不覆盖Data表原有内容：

Sub open_sheet()
    Dim sourcesheet As Worksheet
    Dim targetSheet As Worksheet
    Dim dataSheet As Worksheet
    Dim lastRow As Long
    
    ' 初始化工作表对象
    Set sourcesheet = Sheets("Main")
    Set dataSheet = Sheets("Data")
    
    ' 根据选择匹配对应班级工作表
    Select Case sourcesheet.Range("Class").Value
        Case "Class A"
            Set targetSheet = Sheets("Class A")
        Case "Class B"
            Set targetSheet = Sheets("Class B")
        Case "Class C"
            Set targetSheet = Sheets("Class C")
        Case Else
            MsgBox "无效的班级选择！", vbExclamation
            Exit Sub
    End Select
    
    targetSheet.Activate
    
    ' 计算Data表新数据插入行（最后一行的下一行）
    lastRow = dataSheet.Cells(dataSheet.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 复制班级表的成绩数据（请根据实际数据范围修改A2:E2）
    targetSheet.Range("A2:E2").Copy
    ' 粘贴值和格式到Data表，避免公式引用问题
    dataSheet.Cells(lastRow, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    ' 清除剪贴板，释放资源
    Application.CutCopyMode = False
    
    MsgBox "数据已成功保存到Data工作表！", vbInformation
End Sub

关键细节说明 #

• 替换多分支If为Select Case：比原代码更简洁，同时增加了无效输入的提示逻辑，避免无意义的执行。
• 动态定位插入行：通过End(xlUp)自动找到Data表已有数据的最后一行，确保新数据始终追加在末尾，不会覆盖原有内容。
• 值粘贴模式：使用xlPasteValuesAndNumberFormats只粘贴计算后的结果和格式，防止Data表出现指向班级表的无效公式引用。

注意事项 #

• 请自行调整代码中的targetSheet.Range("A2:E2")，替换成你班级工作表中实际存储成绩、百分比等数据的单元格范围。
• 确保Data表已提前设置好表头（比如A列姓名、B列语文成绩、C列百分比等），保证追加的数据能对应正确列位。

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