将整个行从一个Excel工作表复制到另一工作表的下一个空行

Question

I have two sheets data and PrevErrCheck . I am checking all occurrence of variable VarVal (this variable has data in E1 cell of PrevErrCheck ) in sheet data and copy entire row to sheet PrevErrCheck . But the problem I am facing here is running macro multiple times overwriting data. I would like to keep the copied rows in sheet data and whenever I run next time, it should copy to next blank row.

I am using below code currently but bit confused to how to integrate the the option to find last row on PrevErrCheck and copy lines below that

Sub PrevErrCheck()    
    Dim spem As Workbook
    Dim PrevErrCheck As Worksheet
    Dim data As Worksheet
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long

    Set spem = Excel.Workbooks("SwitchPortErrorMonitor.xlsm")
    Set PrevErrCheck = spem.Worksheets("PrevErrCheck")
    Set data = spem.Worksheets("data")

    spem.Worksheets("PrevErrCheck").Activate 
    VarVal = PrevErrCheck.Cells(1, "E").Value
    I = data.UsedRange.Rows.count
    J = PrevErrCheck.UsedRange.Rows.count

    If J = 1 Then
        If Application.WorksheetFunction.CountA(PrevErrCheck.UsedRange) = 0 Then J = 0
    End If

    Set xRg = data.Range("X:X")
    On Error Resume Next

    Application.ScreenUpdating = False

    J = 3
    For K = 1 To xRg.count      
        If CStr(xRg(K).Value) = VarVal And Not IsEmpty(VarVal) Then
            xRg(K).EntireRow.Copy Destination:=PrevErrCheck.Range("A" & J + 1)
            PrevErrCheck.Range("X" & J + 1).ClearContents
            J = J + 1
        End If    
    Next

    Application.ScreenUpdating = True
End Sub

Answer 1

You have J = 3 before the loop, that may be a problem. xRg.count always returns 1048576, you should use something more specific. Try this:

Set spem = Excel.Workbooks("SwitchPortErrorMonitor.xlsm")
Set PrevErrCheck = spem.Worksheets("PrevErrCheck")
VarVal = PrevErrCheck.Cells(1, "E").Value
If IsEmpty(VarVal) Then Exit Sub

Set data = spem.Worksheets("data")

spem.Worksheets("PrevErrCheck").Activate
I = data.UsedRange.Rows.Count
J = PrevErrCheck.UsedRange.Rows.Count + 1
If J = 2 Then
    If IsEmpty(PrevErrCheck.Cells(1, 1)) Then J = 1
End If

'    If J = 1 Then
'        If Application.WorksheetFunction.CountA(PrevErrCheck.UsedRange) = 0 Then J = 0
'    End If

'    Set xRg = data.Range("X:X")
'    On Error Resume Next

'    Application.ScreenUpdating = False

'    J = 3
For K = 1 To I
    If CStr(data.Cells(K, "X").Value) = VarVal Then
        data.Cells(K, 1).EntireRow.Copy Destination:=PrevErrCheck.Range("A" & J)
        PrevErrCheck.Range("X" & J).ClearContents
        J = J + 1
    End If
Next

'   Application.ScreenUpdating = True
End Sub