Код Excel VBA для копирования диапазона ячеек в строке и вставки на другой лист, но с той же строкой / диапазоном, когда значение в 1-й ячейке изменяется

Question

Мне нужен код vba, чтобы скопировать диапазон ячеек в строке (например, Sheet1! A2: I2), и вставить его в другой лист (например, «Sheet2»), но в той же строке (например, Sheet 2! A2: I2) ), чтобы это происходило автоматически при изменении значения в столбце «K2», обратите внимание, что K2-K100 содержат значения, которые могут изменяться.

Так что, если изменяется K3 листа 1, то A3: I3 листа 1 следует автоматически скопировать в A3: I3 листа 2, аналогично, если изменяется K4 листа 1, то A4: I4 листа 1 следует автоматически скопировать в A4: I4 листа 2

Любые предложения;

PS: новичок в работе vba, извинения, если я не написал свой запрос должным образом

Answer 1

«Worksheet_Change»: Automati c (управляемая событиями) Копирование

• Скопируйте этот код в отслеживаемый рабочий лист и измените значения в разделе констант, в частности, «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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''