VBA宏数据覆盖问题求助：实现向已有数据的Excel追加数据

Hey there! It's totally normal to hit this snag when starting out with VBA macros—let's tweak your code so it adds new data below the existing content in your destination file instead of wiping it out.

What's Causing the Overwrite? #

The core issue in your original code is this line:

shSF.Range("A1:C" & LastRow).Copy Destination:=sh1.Range("A1")

By setting the paste destination to A1, you're telling Excel to drop the new data right at the top of the sheet, which replaces any existing content there. We need to first find the last row with data in the destination sheet, then paste starting from the very next empty row.

Modified Working Code #

Here's the updated version of your macro with all the fixes:

Sub AppendDataToDestination()
    Dim shSF As Worksheet, sh1 As Worksheet
    Dim wb As Workbook, LastRowSource As Long, LastRowDest As Long
    Dim wt As Worksheet
    
    ' Set source sheet (explicitly tied to the workbook running the macro)
    Set shSF = ThisWorkbook.Worksheets("Sheet2")
    ' Get last row with data in the source sheet
    LastRowSource = shSF.Range("A" & shSF.Rows.Count).End(xlUp).Row
    
    ' Open the destination workbook
    Set wb = Workbooks.Open("C:\DestinationPath.xlsm")
    ' Set destination sheet
    Set sh1 = wb.Worksheets("Sheet2")
    ' Get last row with data in the destination sheet
    LastRowDest = sh1.Range("A" & sh1.Rows.Count).End(xlUp).Row
    
    ' Handle empty destination sheet case (paste starting at A1 if no data exists)
    If LastRowDest = 1 And sh1.Range("A1").Value = "" Then
        LastRowDest = 0
    End If
    
    ' Copy from source and paste to the next empty row in destination
    shSF.Range("A1:C" & LastRowSource).Copy Destination:=sh1.Range("A" & LastRowDest + 1)
    
    ' Clear content from Sheet1 in the macro's workbook (explicit reference)
    Set wt = ThisWorkbook.Worksheets("Sheet1")
    wt.Range("A2:B" & LastRowSource).ClearContents
    
    ' Save and close the destination workbook (cleanup step)
    wb.Save
    wb.Close
End Sub

Key Changes Breakdown #

• Clearer variable names: Renamed LastRow to LastRowSource and added LastRowDest to avoid confusion between source and destination sheet rows.
• Found destination's last row: LastRowDest = sh1.Range("A" & sh1.Rows.Count).End(xlUp).Row locates the bottom-most row with data in your destination sheet's column A.
• Pasted to the next empty row: Instead of pasting to A1, we use sh1.Range("A" & LastRowDest + 1) to drop new data right below existing content.
• Handled empty destination case: The If check ensures that if the destination sheet is completely empty, we paste starting at A1 instead of A2.
• Explicit workbook references: Added ThisWorkbook to specify which workbook Sheet2 and Sheet1 belong to—this prevents bugs if other workbooks are open.
• Cleanup step: Added wb.Close to close the destination file after saving (you can remove this if you want to keep it open).

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