Excel跨工作簿数据提取VBA脚本修改：从第50行开始写入

Here's the adjusted script that extracts data to a separate workbook in the same directory as your source file, starting at row 50 in the target workbook:

Sub ExtractToAnotherWorkbook()
    Dim SourceSheet As Worksheet
    Dim TargetWorkbook As Workbook
    Dim TargetSheet As Worksheet
    Dim SourceLastRow As Long
    Dim SourceLastCol As Long
    Dim TargetStartRow As Long
    Dim TargetWBPath As String
    
    ' Set the starting row in target workbook
    TargetStartRow = 50
    
    ' Get the path to the target workbook (same directory as source)
    ' Replace "TargetWorkbook.xlsx" with your actual target filename
    TargetWBPath = ThisWorkbook.Path & "\TargetWorkbook.xlsx"
    
    ' Set source sheet based on cell D2 in Sheet1
    Set SourceSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets("Sheet1").Range("D2").Value2)
    
    ' Check if target workbook exists, open it if it does
    On Error Resume Next
    Set TargetWorkbook = Workbooks.Open(TargetWBPath)
    On Error GoTo 0
    
    ' If target workbook doesn't exist, create a new one
    If TargetWorkbook Is Nothing Then
        Set TargetWorkbook = Workbooks.Add
        TargetWorkbook.SaveAs Filename:=TargetWBPath
    End If
    
    ' Set target sheet (adjust "Sheet1" to your target sheet name if needed)
    Set TargetSheet = TargetWorkbook.Worksheets("Sheet1")
    
    ' Get used range dimensions from source sheet
    With SourceSheet.UsedRange
        SourceLastRow = .Row + .Rows.Count - 1
        SourceLastCol = .Column + .Columns.Count - 1
    End With
    
    ' Copy the entire used range to target starting at row 50
    ' This is more efficient than looping through each cell
    SourceSheet.Range(SourceSheet.Cells(1, 1), SourceSheet.Cells(SourceLastRow, SourceLastCol)).Copy _
        Destination:=TargetSheet.Cells(TargetStartRow, 1)
    
    ' Save and close the target workbook
    TargetWorkbook.Save
    TargetWorkbook.Close SaveChanges:=False
    
    ' Clean up objects
    Set SourceSheet = Nothing
    Set TargetSheet = Nothing
    Set TargetWorkbook = Nothing
    
    MsgBox "Data extraction completed successfully!", vbInformation
End Sub

Key Changes Explained: #

• Cross-Workbook Targeting: We use ThisWorkbook.Path to grab the directory of your source file, then append the target workbook filename to create a full, valid file path.
• Target Start Row: The TargetStartRow variable is hard-set to 50, so all extracted data begins writing from this row in the target sheet.
• Efficient Copy Method: Ditched the cell-by-cell loop (which gets slow for large datasets) in favor of copying the entire used range in one operation—this is far faster and cleaner.
• Target Workbook Fallback: The script checks if your target workbook exists; if not, it creates a new one and saves it to the correct directory automatically.
• Removed Unnecessary Activation: Got rid of the Worksheets("Sheet1").Activate line—activating sheets is redundant and can slow down your code's performance.

Quick Notes: #

• Replace "TargetWorkbook.xlsx" with your actual target workbook filename (don't forget the correct extension, like .xlsm if the file uses macros).
• Adjust the target sheet name ("Sheet1") if your target workbook uses a different sheet for storing extracted data.

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