使用For Each选择其他工作表单元格及跨工作簿行复制技术问询

I’ve refined and completed your code to handle copying new rows from the master workbook to the slave workbook. The solution uses a unique identifier column to detect rows that don’t exist in the slave, then copies them to the next empty position.

Complete Code #

Sub CopySchedule()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lRow As Long, lRowSlave As Long
    Dim strSearch As String
    Dim foundCell As Range
    Dim keyColumn As Integer ' Column number for unique identifier (e.g., 1 = Column A)
    
    ' --------------------------
    ' Adjust these values first!
    ' --------------------------
    keyColumn = 1 ' Update to your unique ID column
    Set wb1 = ThisWorkbook ' Master workbook (or use Workbooks.Open("C:\Path\Master.xlsx"))
    Set wb2 = Workbooks.Open("C:\Path\To\Slave.xlsx") ' Update slave file path
    Set ws1 = wb1.Worksheets("MasterSheet") ' Master sheet name
    Set ws2 = wb2.Worksheets("SlaveSheet") ' Slave sheet name
    
    ' Get last row with data in master worksheet
    lRow = ws1.Cells(ws1.Rows.Count, keyColumn).End(xlUp).Row
    
    ' Loop through each row in master (skip row 1 if it's a header)
    For i = 2 To lRow
        ' Grab the unique key from current master row
        strSearch = ws1.Cells(i, keyColumn).Value
        
        ' Search for the key in slave worksheet
        Set foundCell = ws2.Columns(keyColumn).Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlWhole)
        
        ' If key not found, copy the entire row to slave
        If foundCell Is Nothing Then
            ' Find next empty row in slave
            lRowSlave = ws2.Cells(ws2.Rows.Count, keyColumn).End(xlUp).Row + 1
            
            ' Copy row from master to slave
            ws1.Rows(i).Copy Destination:=ws2.Rows(lRowSlave)
            
            ' Clear clipboard to avoid lingering selection
            Application.CutCopyMode = False
        End If
    Next i
    
    ' Optional: Save and close slave workbook
    wb2.Save
    wb2.Close
    
    ' Clean up object references
    Set ws1 = Nothing: Set ws2 = Nothing
    Set wb1 = Nothing: Set wb2 = Nothing
    
    MsgBox "New rows copied successfully!", vbInformation
End Sub

Key Adjustments & Notes #

• Unique Key Column: Update keyColumn to match the column with your unique identifier (e.g., 3 for Column C). This is how we detect new rows.
• File/Sheet Names: Replace the workbook paths and sheet names with your actual file details. If the slave workbook is already open, use Set wb2 = Workbooks("Slave.xlsx") instead of Workbooks.Open.
• Header Row: The loop starts at row 2 assuming your data has headers in row 1. If your data starts at row 1, change For i = 2 To lRow to For i = 1 To lRow.
• Save/Close: The code saves and closes the slave workbook by default. Remove those lines if you want to keep it open.

How It Works #

1. Reference Files: Connects to the master and slave workbooks and their target sheets.
2. Find Data Boundaries: Gets the last row of data in both workbooks to avoid unnecessary loops.
3. Check for Existing Rows: Uses the Find method to verify if each master row’s unique key exists in the slave.
4. Copy New Rows: If the key isn’t found, copies the entire row to the next empty row in the slave.
5. Clean Up: Releases object references and shows a completion message.

内容的提问来源于stack exchange，提问作者L. Hicks