If you enter an endless loop, that coul be caused by iLastRow1 being smaller
than 24.

Please check, or send me a copy of your workbook

HTH
--
AP


"Tom" a écrit dans le message de
...
I am having a proble with the following code. It seems to stop at the
second
from last <End if and I don't know why?

TFTH,
Tom

Sub Archive()
Dim iLastRow1 As Long
Dim aLastRow As Long
Dim i As Integer
Dim j As Integer
Dim rw As Long, iCol As Integer

'Determine last row in each activity sheet with a "time back"

iLastRow1 = Sheets("Order Pick").Cells(Rows.Count, "AU").End(xlUp).Row
aLastRow = Sheets("Daily Archive").Cells(Rows.Count, "A").End(xlUp).Row +
1

Application.ScreenUpdating = False

'////////// ORDER PICK ////////////
' Cut and paste each row with a "time back" into the load truck file

For i = iLastRow1 To 24 Step -1
With Sheets("Order Pick").Cells(i, "AU")
If .Value < "" Then
.EntireRow.Cut Sheets("Daily Archive").Cells(aLastRow, "A")
End If
End With
aLastRow = aLastRow + 1
Next i

' Erase empty rows from each activity sheet


For rw = Sheets("Order Pick").UsedRange.Rows.Count To 24 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End(xlToLeft).Column = 1 Then
Rows(rw).Delete
End If
End If
Next




' Erase empty rows from daily archive sheet

Sheets("Daily Archive").Select
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

Application.ScreenUpdating = True

End Sub