I have written the following procedure to copy/sort & delete all the zero rows, the problem is that it takes over a minute to run this code. This is compounded by the fact that I have this same macro for each month of the year and when I run my main macro which runs all 12 months consecutively the whole process takes 19 minutes. Following is the code for one month and then the main macro which runs all 12 months at the same time. Any advice would be greatly appreciated.
Thanks

Sub DoItAll1()
'
' DoItAll Macro
' Macro recorded 10/13/2006
'

Application.ScreenUpdating = False
Range("A1").Select
Sheets("ledger").Select
Range("A1:B1750").Select
Selection.Copy
Sheets("P1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("1st sort").Select
Range("A1:D1750").Select
ActiveWindow.SmallScroll Down:=-18
Application.CutCopyMode = False
Selection.Copy
Sheets("P1").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim i As Integer

i = 1

While Cells(i, 6) <> ""
Cells(i, 6).Select
If Cells(i, 6) = 0 Then
Rows(i).Delete
Else
i = i + 1
End If
Range("F1").Select
Wend

Range("A1:F1750").Select
Application.CutCopyMode = False
Selection.Copy
End Sub


Main code that runs all:


Sub RunAll()
DoItAll1
DoItAll2
DoItAll3
DoItAll4
DoItAll5
DoItAll6
DoItAll7
DoItAll8
DoItAll9
DoItAll10
DoItAll11
DoItAll12
End Sub