[SOLVED]Help with VBA Macro - Returning Entire Row

Hello BamBamMoneyBags,

This revision of the macro will copy the rows to "Sheet2" column "A:D". The macro has been added to the attached workbook.

Sub Button1_Click()

    Dim Data As Variant
    Dim n As Integer
    Dim nMax As Double
    Dim nMin As Double
    Dim r As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim RngOut As Range
    Dim Wks As Worksheet
    
    
        ReDim Data(1 To 4, 1 To 1)
        
        Set RngOut = Worksheets("Sheet2").Range("A1:D1")
        Set Wks = Worksheets("Sheet1")
        
        Set Rng = Wks.Range("A5")
        Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
        
        If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd).Resize(ColumnSize:=5)
        
        
        nMin = Wks.Cells(19, "B")
        nMax = Wks.Cells(20, "B")
        
            For r = 1 To Rng.Rows.Count - 1 Step 2
                If Rng.Item(r, 5) >= nMin And Rng.Item(r + 1, 5) <= nMax Then
                    
                    n = n + 1
                    ReDim Preserve Data(1 To 4, 1 To n)
                    Data(1, n) = Rng.Item(r, 1)
                    Data(2, n) = Rng.Item(r + 1, 1)
                    Data(3, n) = Rng.Item(r, 3)
                    Data(4, n) = Rng.Item(r, 5)
                    
                    n = n + 1
                    ReDim Preserve Data(1 To 4, 1 To n)
                    Data(1, n) = Rng.Item(r, 1)
                    Data(2, n) = Rng.Item(r + 1, 1)
                    Data(3, n) = Rng.Item(r + 1, 3)
                    Data(4, n) = Rng.Item(r + 1, 5)
                    
                End If
            Next r
        
        Data = Application.Transpose(Data)
        RngOut.Resize(UBound(Data), 4).Value = Data
        
End Sub