Hacer una macro que copie una pestaña, y cada pestaña la renombre de acuerdo a una lista
Tengo esta macro, y necesito su apoyo por favor, lo que busco es que copie la pestaña formato, y les cambie el nombre de acuerdo a una lista y que además ese nombre de lista se coloque en una celda de la hoja copiada, lo que tengo es lo siguiente:
Sub crear_hojas_con_lista()
Dim lista As Range
Dim ix As Long
Set lista = Application.InputBox(prompt:="señalar rango de la lista", _
Title:="lista de nombres", Type:=8)
Application.ScreenUpdating = False
For ix = lista.Count To 1 Step -1
Copy AFTER:=Worksheets("fuente")
Sheets.Add.Name = lista(ix)
Next ix
Application.ScreenUpdating = True
End Sub
Esta es la lista:
Pero me hace una copia de la pestaña FORMATO, y no le pone el nombre de "321716", si no que le coloca FORMATO (3), y en seguida hace otra pestaña donde no tiene datos la hoja pero si cambia el nombre a 321716.
Además busco que ese nombre 321716,774046, etc, además de renombrar la pestaña se coloque en la celda M5.
1 Respuesta
En la pestaña formato
Sube tu archivo a la nube porque necesito hacer pruebas
Como lo subo a la nube??
Por dropbox, mega o onedrive te registras y subes tu archivo y compartes el link
Valora la respuesta
Sub Macro_x1()
'
Set h1 = Sheets("Formato")
'
col = "A" 'columna de lista
ini = 2 'fila de inicio de la lista
'
For i = ini To h1.Range(col & Rows.Count).End(xlUp).Row
h1.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = h1.Cells(i, col)
'
Set h20 = ActiveSheet
'
h20.[M5] = h1.Cells(i, col)
Next i
'
MsgBox "FIN"
End Sub
https://www.dropbox.com/s/4sb46q2kxri5gx1/PRUEBA%20DE%20PESTA%C3%91AS.xlsm?dl=0
Pegue el código, pero no me funciona, te comparto el archivo.
Gracias
Valora la respuesta para finalizar
La macro debes copiar a un modulo
Sub Macro_x1()
'
Set h1 = Sheets("Formato")
'
col = "V" 'columna de lista
ini = 11 'fila de inicio de la lista
'
For i = ini To 39
If h1.Cells(i, "V") <> "" Then
h1.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = h1.Cells(i, col)
'
Set h20 = ActiveSheet
'
h20.[M5] = h1.Cells(i, col)
End If
Next i
'
MsgBox "FIN"
End Sub
Te regreso el archivo
https://www.dropbox.com/s/vjv2lehlecu7tv4/PRUEBA%20DE%20PESTA%C3%91AS.xlsm?dl=0
Muchas ¡Gracias! ya esta funcionando el archivo perfectamente
Pase el código a otro archivo donde solo cambian las celdas, hace la función, pero al llegar al ultimo registro se detiene y marca un error 400, y ya no lo renombra, le deja el mismo nombre
https://www.dropbox.com/s/hcz2oum57gahn51/prueba%202.xlsm?dl=0
En la lista tiene tienes repetidos (15, 15) y nombres de hojas de excel no permite nombres repetidos
0
321516
15
14
15
