根據條件將特定單元格從工作表復制到工作表

Question

'子 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 列中所有具有“是”的行。但是，嘗試在與 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