Question

使用我当前正在使用的代码，它将信息从工作表1粘贴到工作表2的顶行中的工作表2。接下来，我想使用相同的代码但要使用不同的单元格值，并将信息从工作表1复制到工作表2，但要复制到工作表2的下一行。

我已经研究Excel宏和vba一段时间了，但仍然遇到麻烦。我一直在不使用Excel代码中的select和Activate进行工作，但是现在我的代码仍然遇到麻烦。我正在尝试使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

使用我的代码复制到下一个可用行

2 个答案: