Если ячейка содержит определенное значение, скопируйте определенные данные в следующую доступную строку

Question

Подобный вопрос для многих других. Для контекста вы хотите использовать этот код для участия учащихся. В идеале пользователь прокручивает список и помещает 1 для каждого отсутствующего ученика. Затем заполняется отсутствующий список.

Мой код довольно рудиментарный, но очень близко к тому, что я хочу, чтобы он делал. Однако, если более 1 строки имеют в нем «1», тогда он будет вытаскивать все данные из всех строк с 1 в нем. Я только хочу, чтобы он вытащил строку, в которую вводится 1. Я чувствую, что я - линия кода, от этого. Диапазоны E: J в моем активном листе - это те данные, которые мне нужны, плюс сегодняшняя дата.

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim i As Integer 

If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then 
    For i = 1 To 9999 
     If Range("A" & i).Value = 1 Then 
      Sheets("Absent List").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Range("E" & i).Value 
      Sheets("Absent List").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Range("F" & i).Value 
      Sheets("Absent List").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = Range("G" & i).Value 
      Sheets("Absent List").Range("D" & Rows.Count).End(xlUp).Offset(1).Value = Range("H" & i).Value 
      Sheets("Absent List").Range("E" & Rows.Count).End(xlUp).Offset(1).Value = Range("I" & i).Value 
      Sheets("Absent List").Range("F" & Rows.Count).End(xlUp).Offset(1).Value = Range("J" & i).Value 
      Sheets("Absent List").Range("G" & Rows.Count).End(xlUp).Offset(1).Value = Date 
      End If 
      Next i 
     End If 
End Sub 

Спасибо,

Answer 1

По зацикливание на колонке А, вы всегда будет копировать данные, когда вы встречаете значение 1.

Вместо этого, если вы установите i в Target.Row то будет только скопировать изменения для строки, которая изменилась.

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim i As Integer 

    If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then 
     i = Target.Row 
     If Range("A" & i).Value = 1 Then 
      ' Do your copying 
     End If 
    End If 
End Sub