Copiar Encabezados a Otras Páginas de la misma Hoja

Desde Perú! Les explico mi problema tengo mi macro que copia códigos de una hoja a otra en el mismo excel si este pertenece al proveedor que ingreso con un pro = Inputbox, pero sucede que me copia de largo y lo que deseo es que como máximo debo copiar 38 códigos por cada página y si sobrepasa esa cantidad, pues que el encabezado de mi primera página se copie a la segunda y también a la tercera si existiesen más productos filtrados por ese proveedor, espero haber podido explicar bien y se me haya entendido

Este es mi Código VBA (Disculpen lo precario, recién he entrado a este mundo de la programación)

Me olvidaba, también hago una copia de la hoja con el nombre que ingrese = pro

Muchas gracias de antemano comunidad.

Sub M3_NewO()

' Limpieza de la Hoja ORD
Sheets("ORD").Select
Range("B5:G42").Select
Selection.ClearContents
Sheets("COT").Select

' Genera orden

InicioR = 4 'Inicio de la hoja Cot
inicioO = 5 'Inicio de la hoja Ord
pro = InputBox("Ingrese Proveedor", "Generando ", IDIVSA)

' Calcula Final de las lineas que poseen códigos escritos
Range("B4").Select
Fin = 4
Celda = "B" & CStr(Fin)
Do While Range(Celda).Text <> ""
Fin = Fin + 1
Celda = "B" & CStr(Fin)
Loop
Fin = Fin - 1
' Hasta aqui calcula final de los códigos escritos

Max = Fin

b = 0
For a = 0 To Max
CeldaR = "H" & CStr(InicioR + a)
p = Range(CeldaR).Text
If p = pro And b < 38 Then ' 38 es el numero máximo de items POR PAGINA
r1 = InicioR + a
O1 = inicioO + b
Call PEGA(r1, O1)
b = b + 1
Sheets("COT").Select
ElseIf b = 38 Then
a = MsgBox("Se lleno la O/C con :" & b & "Productos")
Sheets("ORD").Select
Sheets("ORD").Copy Before:=Sheets(4)
Sheets("ORD (2)").Select
Sheets("ORD (2)").Name = pro
a = InputBox("Ingrese Codigo del Proveedor", "Generando O/C", 0)
Range("I2").FormulaR1C1 = a
Range("B5").Select
MsgBox "Se genero Orden para :" & pro
End
End If
Next a

' para realizar una copia de la hoja
Sheets("ORD").Select
Sheets("ORD").Copy Before:=Sheets(4)
Sheets("ORD (2)").Select
Sheets("ORD (2)").Name = pro
a = InputBox("Ingrese Codigo del Proveedor", "Generando O/C", 0)
Range("I2").FormulaR1C1 = a

' A partir de aqui para que borre los numeros de mas en la orden de compra
' Calcula Final de las lineas que poseen codigos escritos
Range("B5").Select
a = 5
Celda = "B" & CStr(a)
Do While Range(Celda).Text <> ""
a = a + 1
Celda = "B" & CStr(a)
Loop
' Hasta aqui calcula final de los codigos escritos
' Limpieza de la Hoja Orden de Compra
zona = "A" & CStr(a) & ":A100"
Range(zona).Select
Selection.ClearContents
Range("F5").Select
MsgBox "Se genero Orden para :" & pro

End Sub