Auto Remove Rows in List

I need to figure out how to take columns of information that are produced based on formulas and return other columns that take out the blank rows so all information is consecutive.

See attached. First columns have blank rows. 2nd columns have desired result.

Thank you

You can run this macro to delete empty rows. Let me know if this works for you or if you need me to modify it.

[code]
Sub DeleteEmptyRowsAndColumns()
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application. ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application. CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

LastColumn = ActiveSheet.UsedRange.Column - 1 + _
ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
For c = LastColumn To 1 Step -1
If Application.CountA(Columns(c)) = 0 Then Columns(c).Delete
Next c
End Sub
[\code]

Sub DeleteEmptyRowsAndColumns() 
    LastRow = ActiveSheet.UsedRange.Row - 1 + _ 
    ActiveSheet.UsedRange.Rows.Count 
    Application. ScreenUpdating = False 
    For r = LastRow To 1  Step -1 
        If Application. CountA(Rows(r)) = 0 Then Rows(r).Delete 
    Next r 
     
    LastColumn = ActiveSheet.UsedRange.Column - 1 + _ 
    ActiveSheet.UsedRange.Columns.Count 
    Application.ScreenUpdating = False 
    For c = LastColumn To 1 Step -1 
        If Application.CountA(Columns(c)) = 0 Then Columns(c).Delete 
    Next c 
End Sub