The lengthy (not infinite) part of code is the following:

' 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

If yo add MsgBox Sheets("Order Pick").UsedRange.Rows.Count
before that part of code, yo see that UsedRange is very big : 2316 rows.

The Rows(rw).Delete instruction is slow (almost 1 sec per line = 2316-24 =
40 min. approx.

If you comment out de Rows(rw).Delete line, the whole macro runs within
seconds.

-----------
Another point:

I noticed your Order Pick sheet is not empty, but contains no line to be
archived (col AU).
Do you happen to have an earlier version of your file?

HIH,
--
AP

"Tom" a écrit dans le message de
...
Ardus,

Thanks for the help.

Lengthy? How long did it take to run?