Generar archivos distribuyendo el original

H o l a: Ejecuta la siguiente macro en el archivo que quieres dividir los datos. Cambia en la macro "Hoja1" por el nombre de la hoja que contiene los datos.

Cuando ejecutes la macro te pedirá el número de archivos.

Sub GenerarArchivos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    num = InputBox("Escribe el número de archivos", "DIVIDIR INFORMACIÓN")
    If num = "" Then Exit Sub
    '
    ruta = l1.Path & "\"
    nombre = Left(l1.Name, InStrRev(l1.Name, ".") - 1)
    n = 1
    u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row
    filas = WorksheetFunction.RoundUp(u / num, 0)
    For i = 1 To u Step filas
        Set l2 = Workbooks.Add
        Set h2 = l2.Sheets(1)
        h1.Rows(i & ":" & i + filas - 1).Copy h2.Range("A1")
        l2.SaveAs Filename:=ruta & nombre & "_" & n & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        l2.Close
        n = n + 1
    Next
    MsgBox "Fin"
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Muy buenas noches Dante,

Mil Gracias, no dejo de asombrarme con todos los procesos que haces, he utilizado varias de tus macros, son muy buenas y trato de aprender pero en cosas como estas la verdad no llego hasta allá.

Respecto a el código corre perfectamente, pero olvide especificar que cada archivo generado debe llevar la misma plantilla del original, es decir la fila 1 del original debe quedar en todos los archivos generados, sino es mucho pedir me podrías ayudar con este cambio o indicar que debo modificar  en el código.

De nuevo gracias por la ayuda me sera de gran ayuda en mi trabajo.