Question

我正在尝试根据列值复制数据。如果列R无效，则应将所有信息从sheet1复制到sheet2。

我的代码正在运行。由于某种原因，它不会复制我的sheet1的最后两行。我在sheet1中有551行，并且我将551行列R视为无效。 '它仅检查548行并跳过最后一行而不移动它们。

有人可以帮我解决这个问题

Sub Tab()
    Dim cell As Range
    Dim nextrow As Long
    Dim a As Double

    Application.ScreenUpdating = False

    ' get the count of rows in column r
    a = Sheets("sheet1").Cells(Rows.count, "R").End(xlUp).Row
    MsgBox (a)

    For Each cell In Sheets("sheet1").Range("R5:R" & a)
    ' if the cell in column R has invalid, then copy the entire row to another sheet
        If cell.Value = "Invalid" Then
            nextrow = Application.WorksheetFunction.CountA(Sheets("sheet2").Range("R:R"))
            Rows(cell.Row).Copy Destination:=Sheets("sheet2").Range("A" & nextrow + 1)
        End If
    Next

    Application.ScreenUpdating = True
End Sub

Answer 1

而不是

Rows(cell.Row).Copy Destination:=Sheets("sheet2").Range("A" & nextrow + 1)

试

Sheets("sheet1").Rows(cell.Row).Copy Destination:=Sheets("sheet2").Range("A" & nextrow + 1)

您的代码可以写成

Sub Demo()
    Dim cell As Range
    Dim nextrow As Long, a as Long
    Dim srcSht As Worksheet, destSht As Worksheet

    Application.ScreenUpdating = False

    Set srcSht = ThisWorkbook.Sheets("Sheet3")
    Set destSht = ThisWorkbook.Sheets("Sheet6")
    nextrow = Application.WorksheetFunction.CountA(destSht.Range("R:R"))

    With srcSht
        a = .Cells(.Rows.Count, "R").End(xlUp).Row
        MsgBox a
        For Each cell In .Range("R5:R" & a)
            ' if the cell in column R has invalid, then copy the entire row to another sheet
            If cell.Value = "Invalid" Then
                .Rows(cell.Row).Copy Destination:=destSht.Range("A" & nextrow + 1)
                nextrow = nextrow + 1
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

除了逐行粘贴数据外，您还可以使用UNION。

Answer 2

我不会讨论变量和方法（每个人都有自己的脚本编写方式）。我会根据您的基本代码做出回应，希望您的理解很清楚。

Sub Tab()
Dim cell As Range
Dim nextrow As Long
Dim a As Double

Application.ScreenUpdating = False

' get the count of rows in column r
a = Sheets("sheet1").Cells(Rows.count, "R").End(xlUp).Row
MsgBox (a)

'This is assuming that you will always populate starting from the first row Range("A1") in Sheet2
nextrow = 1

For Each cell In Sheets("sheet1").Range("R5:R" & a)
' if the cell in column R has invalid, then copy the entire row to another sheet
    If cell.Value = "Invalid" Then

'Use the EntireRow function to copy the whole row to the Sheet2.
'During the next iteration, it will +1 to nextrow, so the next record will be copied to Range("A2"), next Range("A3") and so forth.

        cell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("a" & nextrow)
        nextrow = nextrow + 1
    End If
Next

Application.ScreenUpdating = True
End Sub

从一张纸复印到另一张纸

2 个答案: