VBA宏修改需求：从源工作簿调用实现跨簿数据追加复制

Hey there! Since you're new to VBA, let's walk through modifying your existing macro to meet your two main needs:

• Copy specific cells (not entire rows) from source workbooks and append them to your target workbook
• Run the macro from the source workbook instead of the target one

Key Issues with the Original Code #

Your current script is set to run from the target workbook (ThisWorkbook refers to the file with the macro), and it copies entire rows instead of the specific cell range you might want. Let's fix both of these.

Modified VBA Code #

Here's the updated version with comments explaining each key change:

Sub ConsolidateFromSource()
' Author: Adapted from Jerry Beaucaire/Jay Chase, updated for source-workbook execution
' Summary: Copy specific cells from source workbook(s) and append to a target workbook
' Runs from the SOURCE workbook (the file you want to copy data FROM)

Dim fTargetPath As String, fTargetName As String
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lastRowSource As Long, nextRowTarget As Long
Dim wbTarget As Workbook

' --- CONFIG THESE VALUES TO MATCH YOUR NEEDS ---
Set wsSource = ThisWorkbook.Sheets("PUT YOUR SOURCE SHEET NAME HERE") ' e.g., "Sheet1"
fTargetPath = "C:\Users\jchase.BRYCEWORLD\Desktop\Test\" ' Path to your target workbook folder
fTargetName = "YOUR_TARGET_WORKBOOK_NAME.xlsx" ' Name of your target file (include .xlsx/.xls)
Dim sourceRange As String: sourceRange = "P14:S" ' The specific columns/range you want to copy
' --- END CONFIG ---

' Speed up macro execution
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

On Error Resume Next
' Try to open the target workbook if it's not already open
Set wbTarget = Workbooks(fTargetName)
If Err.Number <> 0 Then
    Set wbTarget = Workbooks.Open(fTargetPath & fTargetName)
End If
On Error GoTo Cleanup

' Set the target worksheet (change "BM Condition" to your target sheet name)
Set wsTarget = wbTarget.Sheets("BM Condition")

' Find the next empty row in the target sheet (append mode)
nextRowTarget = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row + 1

' Find the last row with data in your source range
lastRowSource = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row ' Adjust "A" to a column that always has data

' Copy the specific cells from source to target
wsSource.Range(sourceRange & lastRowSource).Copy wsTarget.Range("A" & nextRowTarget)

' Optional: If you want to move the source file to an "Imported" folder after copying
' Dim fPathDone As String: fPathDone = fTargetPath & "Imported\"
' MkDir fPathDone ' Creates folder if it doesn't exist
' Name ThisWorkbook.FullName As fPathDone & ThisWorkbook.Name

Cleanup:
' Restore Excel settings
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

' Auto-fit columns in target sheet (optional)
wsTarget.Columns.AutoFit

' Inform user the task is done
MsgBox "Data copied successfully!", vbInformation
End Sub

Step-by-Step Explanation for New Users #

1. Configure the Top Section: Replace the placeholder values with your actual sheet names, target file path, and the cell range you want to copy.

   • wsSource: The sheet in your source workbook that has the data to copy
   • fTargetPath/fTargetName: The location and name of your target workbook (where data gets appended)
   • sourceRange: The specific columns/cells you want to copy (e.g., "P14:S" means columns P to S starting at row 14)

2. How It Works:

   • The macro first checks if your target workbook is already open; if not, it opens it
   • It finds the next empty row in the target sheet so data is appended (not overwritten)
   • It copies only the specific cell range you defined from the source sheet to the target
   • It restores Excel's normal settings and shows a success message

3. Running the Macro:

   • Open your source workbook (the one with the data you want to copy)
   • Press Alt + F11 to open the VBA Editor
   • Insert a new module (Insert > Module)
   • Paste this code into the module
   • Press F5 to run it, or assign it to a button in your source workbook for easier access

Notes for Safety #

• Always backup your source and target workbooks before testing macros
• If you want to move the source file after copying, uncomment the optional section at the bottom
• If your target workbook is already open when you run the macro, the script will use the open version instead of reopening it

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