¿Cómo crear un macro que permita crear copias de la hoja1 y que se nombren según un rango seleccionado?
En mi trabajo me han encargado crear la lista de presupuestos para nuestros nuevos cliestes cada 2 semanas. Necesito crear una copia de nuestro formato de presupuestos para cada una de los clientes en una lista que se encuentra en otra hoja dentro del mismo libro. Además, cada nueva hoja deberá tener el nombre del valor que se encuentre en la dicha lista.
3 respuestas
Como estás mira estos ejemplos tal vez te ayuden
Te anexo la macro.
Solamente actualiza los siguientes datos en la macro con los datos de tu archivo:
Set h1 = Sheets("Formato") 'nombre de la hoja con el formato
Set h2 = Sheets("Clientes") 'nombre de la hoja con los nombres de los clientes
col = "A" 'columna con los nombres de los clientes
fila = 2 'fila dond inician los nombres de los clientesSub Copiar_Formato_Presupuesto()
'Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Formato") 'nombre de la hoja con el formato
Set h2 = Sheets("Clientes") 'nombre de la hoja con los nombres de los clientes
col = "A" 'columna con los nombres de los clientes
fila = 2 'fila dond inician los nombres de los clientes
'
For i = fila To h2.Range(col & Rows.Count).End(xlUp).Row
h1.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = h2.Cells(i, col).Value
Next
Application.ScreenUpdating = True
MsgBox "Fin de creación de hojas"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Te falto mencionar el nombre de la hoja y el rango de que contiene la lista clientes, esta macro supone que tienes la lista en la hoja2 y que comienza en la celda A1, el formato en la hoja en la hoja 1, lo que hace esta macro es primero comprobar que el cliente ya tiene una hoja si es asi copia el formato, si no tiene hoja entonces crea la hoja le asigna un nombre y copia el formato
Sub COPIAR_FORMATO()
Set H1 = Worksheets("HOJA1")
Set H2 = Worksheets("HOJA2")
Set CLIENTES = H2.Range("A1").CurrentRegion
With CLIENTES
R = .Rows.Count: C = .Columns.Count
Set CLIENTES = .Rows(2).Resize(R - 1, C)
For I = 1 To .Rows.Count
CLIENTE = .Cells(I, 1)
On Error Resume Next
buscahoja = (Worksheets(CLIENTE).Name <> "")
NOEXISTE = Err.Number > 0
If NOEXISTE Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = CLIENTE
End If
Sheets("HOJA1").Cells.Copy: Sheets(CLIENTE).Range("a1").PasteSpecial
On Error GoTo 0
Next I
End With
Set CLIENTES = Nothing
End Sub