trying to copy a row and the row before it to another sheet based on a value in column A-CodePudding

'this is what I have so far and it is only sending the one row over not the one before it. I don't think the offset code is working.

Sub Macro1()

    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("A1:A" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "CREDIT" Then
       xRg(K).Offset(-1, 0).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J   1)
         xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J   1)
            J = J   1
        End If
    Next
    Application.ScreenUpdating = True

End Sub

CodePudding user response：

You are copying both rows (xRg(K).Offset(-1, 0).EntireRow and xRg(K).EntireRow) to the same destination row Range("A" & J 1). So the code is copying both rows, but the first copied row is overwritten immediately.

Obvious easy workaround is to increase J twice, once after the first copy (missing) and once after the second (already there). Or Write J 2 for the second row and increase J by 2 afterwards.

However, you can copy both rows at once:

xRg(K).Offset(-1, 0).Resize(2).EntireRow.Copy _ 
        Destination:=Worksheets("Sheet2").cells(j 1, 1).Resize(2).EntireRow
J = J   2