Ayuda con funcionamiento macro

[linacg96]

Hola! Necesito por favor de su ayuda. 

No se de programación pero he intentado guiarme de una macro que creó un conocido para aplicárselo a un archivo que tengo. El tema es que la macro me funciona bien hasta copiar el libro de Excel y crear uno nuevo pero no he podido hacer que se guarde con el nombre de la ruta de archivo. 

 

Agradecería me ayuden. 

 

Esta es la macro usada, adjunto archivo.

Sub control2558()

Application.ScreenUpdating = False

Dim I As Integer

I = 4

While Hoja10.Cells(I, 102) <> ""
    Hoja10.Cells(6, 82) = Hoja10.Cells(I, 102)
                  
    Dim NombreArchivo, RutaArchivo As String
    
    NombreArchivo = "Hoja Control " & Hoja10.Cells(I, 102)
    RutaArchivo = ActiveWorkbook.Path & "\" & NombreArchivo & ".xlsm"
    
    Dim NuevoLibro As Workbook
    Set NuevoLibro = Workbooks.Add
    
    Hoja10.Copy Before:=NuevoLibro.Sheets(1)
           
    NuevoLibro.SaveAs
    
    NuevoLibro.Close
    
                    
I = I + 1

Wend

MsgBox ("Proceso generado con éxito")

Application.ScreenUpdating = True

End Sub
 

 

clave a1.

 

Planillas_2.xlsm

[Israel Cassales]

Por lo que puedo leer la macro se atora aquí:

hace 2 horas, linacg96 dijo:

NuevoLibro.SaveAs

Porque en esa instrucción no le dice donde guardar el libro, una idea es terminar la instrucción algo así:

NuevoLibro.SaveAs Filename:=RutaArchivo

 

Editado el el 22 de abril por Israel Cassales

[Israel Cassales]

Sub control2558()

Application.ScreenUpdating = False

Dim I As Integer

I = 4

While Hoja10.Cells(I, 102) <> ""
    Hoja10.Cells(6, 82) = Hoja10.Cells(I, 102)
                  
    Dim NombreArchivo, RutaArchivo As String
    
    NombreArchivo = "Hoja Control " & Hoja10.Cells(I, 102)
    RutaArchivo = ActiveWorkbook.Path & "\" & NombreArchivo & ".xlsm"
    
    Dim NuevoLibro As Workbook
    Set NuevoLibro = Workbooks.Add
    
    Hoja10.Copy Before:=NuevoLibro.Sheets(1)
           
    NuevoLibro.SaveAs Filename:=RutaArchivo
    
    NuevoLibro.Close
    
                    
I = I + 1

Wend

MsgBox ("Proceso generado con éxito")

Application.ScreenUpdating = True

End Sub

 

[linacg96]

Hola, gracias. No se ejecuta...

 

sale esto: se ha producido el error "424"  en tiempo de ejecución.

Se requiere un objeto

 

Le doy en depurar y me sale en amarillo esta parte

 While Hoja10.Cells(I, 102) <> ""

 

 

 

 

[Israel Cassales]

Ese error es porque no existe la hoja 10 con ese nombre, entonces cámbialo por FT-ADF-2558

[Israel Cassales]

Sub control2558()

Application.ScreenUpdating = False

Dim I As Integer

I = 4

While Sheets("FT-ADF-2558").Cells(I, 102) <> ""
    Sheets("FT-ADF-2558").Cells(6, 82) = Sheets("FT-ADF-2558").Cells(I, 102)
                  
    Dim NombreArchivo, RutaArchivo As String
    
    NombreArchivo = "Hoja Control " & Sheets("FT-ADF-2558").Cells(I, 102)
    RutaArchivo = ActiveWorkbook.Path & "\" & NombreArchivo & ".xlsm"
    
    Dim NuevoLibro As Workbook
    Set NuevoLibro = Workbooks.Add
    
    Sheets("FT-ADF-2558").Copy Before:=NuevoLibro.Sheets(1)
           
    NuevoLibro.SaveAs Filename:=RutaArchivo
    
    NuevoLibro.Close
    
                    
I = I + 1

Wend

MsgBox ("Proceso generado con éxito")

Application.ScreenUpdating = True

End Sub