技术求助：如何将数据追加至其他工作簿/文件？附相关VBA代码

Got it, let's refine your code to properly append data from your Customer and Family worksheets to a target workbook—whether that workbook already exists or needs to be created from scratch. Here's the polished, commented version that handles both scenarios:

Private Sub TransfertoWrkBtn_Click()
    Dim c As Range
    Dim i As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim fSource As Worksheet
    Dim TargetBook As Workbook
    Dim Target As Worksheet
    Dim fTarget As Worksheet
    Dim flname As String
    Dim targetPath As String
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    
    ' Set references to your source worksheets
    Set Source = ActiveWorkbook.Worksheets("Customer")
    Set fSource = ActiveWorkbook.Worksheets("Family")
    
    ' Get filename from user, with validation
    flname = InputBox("Enter File Name (without .xlsx extension):", "Target Workbook Name")
    If flname = "" Then Exit Sub ' Exit if user cancels or leaves blank
    
    ' Define full target path with .xlsx extension
    targetPath = "C:\MSN\" & flname & ".xlsx"
    
    ' Check if target workbook exists
    If Dir(targetPath) <> "" Then
        ' Open existing workbook
        Set TargetBook = Workbooks.Open(targetPath)
    Else
        ' Create new workbook and save it to the target path
        Set TargetBook = Workbooks.Add
        TargetBook.SaveAs Filename:=targetPath
    End If
    
    ' --------------------------
    ' Append data from "Customer" sheet
    ' --------------------------
    ' Check if target "Customer" sheet exists; create if not
    On Error Resume Next
    Set Target = TargetBook.Worksheets("Customer")
    On Error GoTo 0
    If Target Is Nothing Then
        Set Target = TargetBook.Worksheets.Add(After:=TargetBook.Worksheets(TargetBook.Worksheets.Count))
        Target.Name = "Customer"
        ' Copy header row from source to new target sheet
        Source.Rows(1).Copy Destination:=Target.Rows(1)
        lastRowTarget = 1 ' Start appending after header
    Else
        ' Find last used row in target sheet
        lastRowTarget = Target.Cells(Target.Rows.Count, "A").End(xlUp).Row
    End If
    
    ' Copy data from source (skip header if target already has data)
    lastRowSource = Source.Cells(Source.Rows.Count, "A").End(xlUp).Row
    If lastRowTarget = 1 Then
        ' Target is new, copy all data (header already added)
        Source.Rows("2:" & lastRowSource).Copy Destination:=Target.Rows(lastRowTarget + 1)
    Else
        ' Target has data, copy only rows 2 to last from source
        Source.Rows("2:" & lastRowSource).Copy Destination:=Target.Rows(lastRowTarget + 1)
    End If
    
    ' --------------------------
    ' Append data from "Family" sheet (repeat same logic)
    ' --------------------------
    On Error Resume Next
    Set fTarget = TargetBook.Worksheets("Family")
    On Error GoTo 0
    If fTarget Is Nothing Then
        Set fTarget = TargetBook.Worksheets.Add(After:=TargetBook.Worksheets(TargetBook.Worksheets.Count))
        fTarget.Name = "Family"
        fSource.Rows(1).Copy Destination:=fTarget.Rows(1)
        lastRowTarget = 1
    Else
        lastRowTarget = fTarget.Cells(fTarget.Rows.Count, "A").End(xlUp).Row
    End If
    
    lastRowSource = fSource.Cells(fSource.Rows.Count, "A").End(xlUp).Row
    If lastRowTarget = 1 Then
        fSource.Rows("2:" & lastRowSource).Copy Destination:=fTarget.Rows(lastRowTarget + 1)
    Else
        fSource.Rows("2:" & lastRowSource).Copy Destination:=fTarget.Rows(lastRowTarget + 1)
    End If
    
    ' Save changes to target workbook and close it (optional, adjust as needed)
    TargetBook.Save
    TargetBook.Close SaveChanges:=False ' Already saved, so no need to prompt
    
    ' Clean up object references
    Set Source = Nothing
    Set fSource = Nothing
    Set TargetBook = Nothing
    Set Target = Nothing
    Set fTarget = Nothing
    
    MsgBox "Data transferred successfully!", vbInformation
End Sub

Key Improvements & Explanations: #

• File Existence Check: Uses Dir(targetPath) to detect if the target workbook already exists—no more overwriting existing files accidentally.
• Automatic File Extension: Adds .xlsx to the filename to avoid invalid file paths.
• Target Worksheet Handling: Checks if the target sheet (Customer/Family) exists; creates it with a header if it doesn't.
• Smart Data Appending: Calculates the last used row in the target sheet to ensure data is added below existing content. Skips the source header when appending to an existing sheet.
• Error Handling: Basic error checking to handle missing sheets gracefully.
• Cleanup: Properly releases object references and includes a success message for user feedback.

Notes: #

• Adjust the targetPath (currently C:\MSN\) to match your actual desired folder.
• If you don't want to close the target workbook automatically, remove the TargetBook.Close line.
• This assumes your data starts in column A and uses contiguous rows (no blank rows in the middle of your data).

内容的提问来源于stack exchange，提问作者ליאור ברקו