Как сделать множественный выбор с ActiveCell

Question

Я пытаюсь сделать несколько выборов из Sheet2.Значение берется из одного и того же столбца, но из разных строк (возможно, будет целесообразно использовать ActiveCell.Offset (1,0)).

Мой код берет значение из выбора ActiveCell и запускает макрос, сравнивает его с другим листом (Sheet10) с некоторой информацией для копирования и вставки в целевой лист (Sheet5).

Следующееэто код, который у меня есть сейчас.

a = Sheet10.Cells(Rows.Count, 1).End(xlUp).Row
c = Sheet2.Cells(Rows.Count, 5).End(xlUp).Row

For Each cell In Range(ActiveCell, ActiveCell.Offset(1, 0))

For i = 2 To a 'from Row 1 to the last row of "DMP"
Debug.Print ("i = " & i)

If cell.Value = Sheet10.Cells(i, 1).Value Then 'if selected cell matches (i,1) of "Sheet10 (DMP)"
    Debug.Print ("ActiveCell =" & ActiveCell.Value)

    For k = 1 To 20 'from Column 1 to Column 20
        Debug.Print ("k = " & k)

        For r = 1 To c 'from Row 1 to the last row of "Sheet 2(LightOn SKU)"
            Debug.Print ("r = " & r)

            If Sheet10.Cells(i, k).Value = Sheet2.Cells(r, 4).Value Then 'if value of (i,k) of "Sheet10 (DMP)" = (r,4) of "Sheet2 (LightOn SKU)"

                Sheet2.Range("A" & r & ":G" & r).Copy
                Sheet5.Activate
                b = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
                Sheet5.Cells(b + 1, 1).Select
                ActiveSheet.Paste
                Range("A" & r & ":L" & r).Borders.Color = vbBlack
             End If

        Next

    Next

End If

Next

Next

Сейчас он работает по бесконечному циклу.

Answer 1

Все еще неясно

Sub ACCopy2()

  Dim a As Long
  Dim c As Long
  Dim r As Long
  Dim i As Long
  Dim k As Integer
  Dim b As Long

  a = Sheet10.Cells(Rows.Count, 1).End(xlUp).Row
  c = Sheet2.Cells(Rows.Count, 5).End(xlUp).Row

  For r = 1 To c ' from Row 1 to the last row of "Sheet 2(LightOn SKU)"
    Debug.Print ("r = " & r)
    For i = 2 To a ' from Row 1 to the last row of "DMP"
      Debug.Print ("i = " & i)
      ' if selected cell matches (i,1) of "Sheet10 (DMP)"
      If Sheet2.Cells(r, 1).Value = Sheet10.Cells(i, 1).Value Then
        Debug.Print ("Sheet2 =" & Sheet2.Cells(r, 1).Value)
        For k = 1 To 20 ' from Column 1 to Column 20
          Debug.Print ("k = " & k)

          ' if value of (i,k) of "Sheet10 (DMP)" = (r,4) of
          ' "Sheet2 (LightOn SKU)"
          If Sheet10.Cells(i, k).Value = Sheet2.Cells(r, 4).Value Then
            With Sheet5
              b = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
              Sheet2.Range("A" & r & ":G" & r).Copy .Cells(b + 1, 1)
              .Range("A" & r & ":L" & r).Borders.Color = vbBlack
            End With
          End If

        Next
      End If
    Next
  Next

End Sub