根据条件在工作表之间复制特定的单元格

Question

'Sub CopyRowToSheet23（）

Worksheets("Sheet2").Range("A2:E1000").Clear
Dim LastRowSheet1, LastRowSheet2 As Long
Dim i As Long
Application.ScreenUpdating = False
LastRowSheet2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("A2:E" & LastRowSheet2).ClearContents
LastRowSheet1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Sheet1")
    For i = 2 To LastRowSheet1 Step 1
        If Cells(i, "E").Value = "YES" Then
            LastRowSheet2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
            Rows(i).Copy Worksheets("Sheet2").Range("A" & LastRowSheet2 + 1)
        End If
    Next i
End With
Application.ScreenUpdating = True
Sheet3.Select

结束字幕”

我设法创建了上面的代码，以获取E列中所有具有“ yes”的行。但是，在尝试在不同于Sheet1的其他工作表中运行宏时遇到了问题。我想在sheet3中运行它，但是我没有找到为什么它没有帮助。

Answer 1

尝试：

Option Explicit

Sub test()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim wsRE As Long, i As Long, LastrowC As Long, LastrowE As Long, LastrowF As Long

    'Set ws1
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    'Set ws2
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    wsRE = ws2.Cells(ws2.Rows.Count, "E").End(xlUp).Row

    'Starting from Row 2 - let us assume that their is a header
    For i = 2 To wsRE
        'Check if the value in column E is yes
        If ws2.Range("E" & i).Value = "Yes" Then
            'Find the Last row in Sheet1 Column C
            LastrowC = ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Row
            'Copy row i, Column A from Sheet 1 and paste it in Sheet 2 after the lastrow in column C
            ws2.Range("A" & i).Copy ws1.Cells(LastrowC + 1, 3)
            'Find the Last row in Sheet1 Column E
            LastrowE = ws1.Cells(ws1.Rows.Count, "E").End(xlUp).Row
            'Copy row i, Column B from Sheet 1 and paste it in Sheet 2 after the lastrow in column E
            ws2.Range("B" & i).Copy ws1.Cells(LastrowE + 1, 5)
            'Find the Last row in Sheet1 Column F
            LastrowF = ws1.Cells(ws1.Rows.Count, "F").End(xlUp).Row
            'Copy row i ,Column C from Sheet 1 and paste it in Sheet 2 after the lastrow in column F
            ws2.Range("C" & i).Copy ws1.Cells(LastrowF + 1, 6)

        End If

    Next i

End Sub