Sub test()
Set currcell = ActiveCell ' Запоминаем активную ячейку
ActiveSheet.Columns("F:F").ClearContents 'Очистка столбца перед проставкой номеров
ActiveSheet.PageSetup.PrintArea = ""
'Application.ScreenUpdating = False ' Отключаем обновление экрана
Application.Cells(65536, 256).Select 'Активная ячейка должна быть самой нижней и самой правой
'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663&Product=xlw2K
Page_Count = ActiveSheet.HPageBreaks.Count ' количество промежутков между страницами
Cells(2, 6) = "1" ' Ставим первый номер страницы
If Page_Count <> 0 Then ' 0 - если всего один лист
For i = 1 To Page_Count 'счет от второго листа до последнего
Ctp = ActiveSheet.HPageBreaks(i).Location.Row 'номер первого ряда листа i
Cells(Ctp+1, 6) = i + 1 ' Ставим следующие номера страниц
Next i
End If
currcell.Select ' Возвращаемся на активную ячейку до запуска макроса
'Application.ScreenUpdating = True ' Включаем обновление экрана
End Sub