Блог

С помощью кода, который я использую в настоящее время, он вставит информацию с листа 1 на лист 2 в верхней строке листа 2. Что я хочу дальше, так это использовать тот же код, но для разных значений ячеек и скопировать информацию с листа 1 на лист 2, но в следующей доступной строке на листе 2.

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

 Sub Copy()

Dim Cell As Range
Dim myRow As Long

myRow = 1
With Sheets("Sheet1")
    For Each Cell In .Range("A1:A" amp; .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
  

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

 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
  

Попробуйте:

 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" amp; i).Value = "Tuck Chow" And .Range("B" amp; 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