Também poderia ser incrementado um loop (no lugar do botão) nessa macro, informava quantos loops deveriam ser dados. Tipo assim: A macro vai rodar 3000 vezes até completar a tarefa.

Sub Aplicador()
Application.ScreenUpdating = False

Sheets("Alimentador").Select
Range("C1:I1").Select
Selection.Copy
Sheets("Distrib").Select
Range("AK2").Select
ActiveSheet.Paste
Range("R2").Select
Sheets("Alimentador").Select
Range("D1").Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Sheets("Distrib").Select

Range("AL20:BE20").Select
Selection.Copy
Range("E3858").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E22:AJ3858").Select
Range("E3858").Activate
Application.CutCopyMode = False
Selection.Copy
Range("E21").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Range("E3858:X3858").Select
Selection.ClearContents

Range("AJ3855:AJ3856").Select
Selection.AutoFill Destination:=Range("AJ3855:AJ3857"), Type:=xlFillDefault
Range("R2").Select

Selection.ClearContents
Application.ScreenUpdating = True
End Sub