Cómo Crear Archivos por Hojas

Código

Sub CrearArchivoPorHoja()

    Dim ws As Worksheet

    Dim wbNuevo As Workbook

    Dim Ruta As String

    Dim NombreArchivo As String

    If ThisWorkbook.Path = "" Then

        MsgBox "Primero guarda el libro.", vbExclamation

        Exit Sub

    End If

    Ruta = ThisWorkbook.Path & "\"

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    For Each ws In ThisWorkbook.Worksheets

        ws.Copy

        Set wbNuevo = ActiveWorkbook

        NombreArchivo = ws.Name

        ' Reemplaza caracteres no permitidos en nombres de archivo

        NombreArchivo = Replace(NombreArchivo, "\", "-")

        NombreArchivo = Replace(NombreArchivo, "/", "-")

        NombreArchivo = Replace(NombreArchivo, ":", "-")

        NombreArchivo = Replace(NombreArchivo, "*", "-")

        NombreArchivo = Replace(NombreArchivo, "?", "-")

        NombreArchivo = Replace(NombreArchivo, """", "-")

        NombreArchivo = Replace(NombreArchivo, "<", "-")

        NombreArchivo = Replace(NombreArchivo, ">", "-")

        NombreArchivo = Replace(NombreArchivo, "|", "-")

        wbNuevo.SaveAs Filename:=Ruta & NombreArchivo & ".xlsx", FileFormat:=xlOpenXMLWorkbook

        wbNuevo.Close SaveChanges:=False

    Next ws

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

    MsgBox "Archivos creados correctamente en:" & vbCrLf & Ruta, vbInformation

End Sub

⭐ Si te gustó, por favor regístrate en nuestra Lista de correo y Suscríbete a mi canal de YouTube para que estés siempre enterado de lo nuevo que publicamos