Скопируйте на следующую доступную строку с моим кодом

Question

Используя код, который я сейчас использую, он вставит информацию из Рабочего листа 1 в рабочий лист 2 в Верхней строке рабочего листа2. Далее я хочу использовать тот же код, но для других значений ячеек, и скопировать информацию из листа 1 в лист 2, но в следующую доступную строку в листе 2.

Я уже некоторое время изучаю макросы Excel и VBA, и у меня все еще есть проблемы. Я работал над тем, чтобы не использовать выбор и активацию в своем коде Excel, но у меня все еще есть проблемы с моим кодом. Я пытаюсь максимально автоматизировать мою книгу Excel для более легкого использования.

Sub Copy()

Dim Cell As Range
Dim myRow As Long

myRow = 1
With Sheets("Sheet1")
    For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)  
        If Cell.Value = "Tuck Chow" And Cell.Offset(0, 1).Value = "OPT" Then
            .Rows(Cell.Row).Copy Destination:=Sheets("Sheet2").Rows(myRow)
            myRow = myRow + 1
        End If
     Next Cell
End With
End Sub

Answer 1

Я бы сделал что-то вроде этого:

Sub Copy()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim newRow As Long

'setting sheets
Set sh1 = ThisWorkbook.Worksheets("Sheet1")
Set sh2 = ThisWorkbook.Worksheets("Sheet2")

With sh1
    For Each cel In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
        If cel.Value = "Tuck Chow" And cel.Offset(0, 1).Value = "OPT" Then
            'getting new row on Sheet2
            If sh2.Cells(1, 1) = "" Then
                newRow = 1
            Else
                newRow = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
            'copying
            cel.EntireRow.Copy Destination:=sh2.Cells(newRow, 1)
        End If
    Next cel
End With

'deselecting row
sh2.Cells(1, 1).Select

End Sub

Answer 2

Попробуйте:

Option Explicit

Sub test()

    Dim LastRow1 As Long, LastRow2 As Long, i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To LastRow1

            If .Range("A" & i).Value = "Tuck Chow" And .Range("B" & i).Value = "OPT" Then

                LastRow2 = ThisWorkbook.Worksheets("Sheet2").Cells(ThisWorkbook.Worksheets("Sheet2").Rows.Count, "A").End(xlUp).Row

                .Rows(i).Copy ThisWorkbook.Worksheets("Sheet2").Rows(LastRow2 + 1)

            End If

         Next i

    End With

End Sub