Data created by macro is not rolling to next page

[retrobeast]

I posted the following problem in the URL below and got the answer I needed by the amazing AlphaFrog.

What I need now is to know how to make data with more lines then a page actually go to the next page?
What is happening currently is that instead of flowing to next page the data just gets hidden on at the bottom of the first page. If I make the font smaller on the excel data it shows up.
Thanks



http://www.mrexcel.com/forum/showthread.php?t=521919



Code:
Sub Consolidate2()

Dim LR As Long, i As Long, MyVal As String

Application.ScreenUpdating = False

ActiveSheet.Copy After:=Sheets(Sheets.Count)

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = LR To 2 Step -1

If Not IsEmpty(Cells(i, "F")) Then MyVal = Cells(i, "F").Value & " - Qty:" & Cells(i, "G")

If Cells(i, "A") = Cells(i - 1, "A") Then
Cells(i - 1, "G") = Cells(i - 1, "G") & "," & vbLf & MyVal
Rows(i).EntireRow.Delete (xlShiftUp)
Else
Cells(i, "F") = MyVal
End If

Next i

Columns("F").ColumnWidth = 100
Columns("F").AutoFit
Range("B:B, E:E, G:J").Delete

Range("B:B").NumberFormat = "mm/dd/yyyy"

Application.ScreenUpdating = True

End Sub

 

[AlphaFrog]

Sub Consolidate3()

    Dim LR As Long, i As Long, MyVal As String
    
    Const MaxLines As Byte = 20 [COLOR="Green"]' Maximum number of items in column D[/COLOR]
    
    Application.ScreenUpdating = False
    
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    
    LR = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = LR To 2 Step -1
    
        If Not IsEmpty(Cells(i, "F")) Then MyVal = Cells(i, "F").Value & " - Qty:" & Cells(i, "G")
    
        If Cells(i, "A") = Cells(i - 1, "A") Then
            Cells(i - 1, "G") = Cells(i - 1, "G") & "," & vbLf & MyVal
            Rows(i).EntireRow.Delete (xlShiftUp)
        Else
            Cells(i, "F") = MyVal
        End If
        
    Next i
    
    Range("B:B, E:E, G:J").Delete
    
    LR = Range("D" & Rows.Count).End(xlUp).Row
    Range("D1:D" & LR).Copy Range("E1")
    Range("E2:E" & LR).ClearContents
    For i = LR To 2 Step -1
        MyVal = Cells(i, "D").Value
        If UBound(Split(MyVal, vbLf)) >= MaxLines Then
            Cells(i, "E").Value = Split(MyVal, vbLf, MaxLines + 1)(MaxLines)
            Cells(i, "D").Value = Left(MyVal, Len(MyVal) - Len(Cells(i, "E").Value) - 2)
        End If
    Next i
    
    Range("B:B").NumberFormat = "mm/dd/yyyy"
    Columns("D:E").ColumnWidth = 200
    Columns("D:E").AutoFit
    Rows("2:" & LR).AutoFit
    
    Application.Goto ActiveSheet.Range("A1"), True
    Application.ScreenUpdating = True
    
End Sub

 

[retrobeast]

AlphaFrog Happy Friday !
I will take the macro out for a test drive later today.
Thanks for putting up with my lack of giving the right instructions to you.
Retrobeast