當第一個單元格上的值發生變化時，Excel VBA 代碼復制一行中的一系列單元格並粘貼到不同的工作表但相同的行/范圍

Question

我需要一個 vba 代碼來復制一行中的一系列單元格（例如：Sheet1！A2:I2），並將其粘貼到不同的工作表（例如“Sheet2”）但同一行（即Sheet 2！A2:I2）中，需要這會在“K2”列中的值更改時自動發生，請注意 K2-K100 包含可以更改的值。

所以如果sheet 1的K3改變，那么sheet 1的A3:I3應該自動復制到sheet 2的A3:I3，同樣如果sheet 1的K4改變，那么sheet 1的A4:I4應該自動復制到A4:I4第 2 頁

任何善意的建議；

PS：vba 新手，如果我沒有正確寫出我的請求，請見諒

Answer 1

“Worksheet_Change”：自動（事件驅動）復制

• 將此代碼復制到被監視的工作表並更改常量部分中的值，特別是“strPaste”，即要寫入的工作表的名稱。

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:  If data changes in cells of a specified column in the worksheet    '
'           containing this code, automatically (event driven) copies          '
'           the row ranges determined by the rows of the changed cells         '
'           and other specified conditions to the same row ranges on another   '
'           specified worksheet.                                               '
' Remarks:  This worksheet will be monitored, another will be written to.      '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Worksheet_Change(ByVal Target As Range)

    ' Constants (change to fit your needs)
    Const strPaste As String = "Sheet2"   ' Paste WorkSheet Name
    Const FR As Long = 2                  ' First Row Number
    Const FC As Long = 1                  ' First Column Number
    Const LC As Long = 9                  ' Last Column Number
    Const CC As Long = 11                 ' Criteria Column Number

    Dim wsPaste As Worksheet              ' Paste Worksheet
    Dim rngC As Range                     ' Criteria Column Range
    Dim rngCC As Range                    ' Current Criteria Cell Range
    Dim LR As Long                        ' Last Row Number
    Dim RCO as long                       ' Resize ColumnSize

    ' Prevent events staying disabled if something goes wrong.
    On Error GoTo ProcedureExit

    ' Caclulate Last Row Number (LR).
    LR = Me.Cells(Me.Rows.Count, CC).End(xlUp).Row
    ' Initialize Criteria Column Range (rngC).
    Set rngC = Me.Cells(FR, CC).Resize(LR - FR + 1)

    ' Check if there has been a change in Criteria Column Range (rngC).
    If Not Intersect(Target, rngC) Is Nothing Then

        On Error Resume Next
            ' Initialize Paste Worksheet (wsPaste).
            Set wsPaste = Worksheets(strPaste)
            ' Check if Paste Worksheet (wsPaste) was initialized.
            If wsPaste Is Nothing Then GoTo WorksheetError
        On Error GoTo ProcedureExit

        ' Calculate Resize ColumnSize (RCO).
        RCO = LC - FC + 1

        ' Disable events to speed up write operations.
        Application.EnableEvents = False

        ' Loop through found Criteria Cells (rngCC).
        For Each rngCC In Intersect(Target, rngC)
            ' Copy values from this worksheet (Me) to Paste Worksheet (wsPaste).
            wsPaste.Cells(rngCC.Row, FC).Resize(, RCO).Value _
              = Me.Cells(rngCC.Row, FC).Resize(, RCO).Value
        Next

    End If

ProcedureExit:
    ' Enable events.
    Application.EnableEvents = True

Exit Sub

WorksheetError:
    MsgBox "There is no worksheet named '" & strPaste & "'. " & vbCrLf _
      & "Change 'Paste WorkSheet Name' ('strPaste') in VBA (Alt+F11).", _
      vbCritical, "Wrong Worksheet Name"
    GoTo ProcedureExit

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''