¿Como puedo eliminar las copias de hojas creadas al ejecutar una macro más de una vez ?

Tengo una macro programada para crear hojas nuevas con un formato predefinido ubicado en una hoja denominada "Formato" la cual a su vez toma los nombres de una lista ubicada en la columna A de la "Hoja 1". No obstante cuando la macro se ejecuta más de una vez, las hojas generadas toman el siguiente formato de nombre; Formato (2) Formato (3)... Formato (12)... Frente a esto quisiera saber como puedo evitar se evitar que se generen copias de la Hoja "Formato" cuando la Macro es ejecutada más de una vez adjunto más abajo la macro realizada .

Private Sub CommandButton1_Click()

Max = 45

For Cont = 2 To Max

Nombre = Cells(Cont, 1)

If Nombre <> "" Then
On Error Resume Next

Application.ScreenUpdating = False
Sheets("Formato").Visible = True
Sheets("FORMATO").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Nombre
Application.ScreenUpdating = True
Sheets("Formato").Visible = Falso
Sheets("1").Select
End If

Next Cont

End Sub

2 respuestas

Respuesta
3

Prueba con esta macro modificada, el problema de tu macro es que no le indicas que hacer cuando se repite el nombre de la hoja por eso crea formato(2), formato(3), el error no lo ves porque la instrucción on error resume hace que la macro ignore ese error y se salte a la siguiente línea, la modificación le indica a la macro que cuando este error se presente borre cualquier página que cree con esos nombres, si la vuelves a correr no te pondrá esos nombres

Sub crea()
Application.DisplayAlerts = False
Max = 45
For Cont = 2 To Max
Nombre = Cells(Cont, 1)
If Nombre <> "" Then
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Formato").Visible = True
Sheets("FORMATO").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Nombre
If Err.Number = 1004 Then ActiveSheet.Delete: GoTo otro
Application.ScreenUpdating = True
Sheets("Formato").Visible = Falso
Sheets("1").Select
On Error GoTo 0
End If
otro:
Next Cont
End Sub

¡Gracias!  Estimado un abrazo.

Con la misma macro ¿como podría eliminar también las hojas que ya no forman parte de la columna A de la hoja denominada "Hoja 1"?

De nuevo modifique tu macro prueba, hoja que no este en la lista sera eliminada junto con los formato(1), formato(2)...

Sub CREAR()
Application.DisplayAlerts = False
Set datos = Sheets("formato").Range("a2").CurrentRegion
For Each hoja In Worksheets
    nombre = hoja.Name
    cuenta = WorksheetFunction.CountIf(datos, nombre)
    If cuenta = 0 Then Sheets(nombre).Delete
Next hoja
With datos
    f = .Rows.Count
    For i = 1 To f
        nombre = .Cells(i, 1)
        If nombre = vbNullString Then GoTo otro
        On Error Resume Next
                With Sheets("formato")
                    .Visible = True
                    .Copy After:=Worksheets(Worksheets.Count)
                    On Error Resume Next
                    ActiveSheet.Name = nombre
                    If Err.Number = 1004 Then ActiveSheet.Delete: GoTo otro
                    .Visible = False
                End With
        On Error GoTo 0
otro:
    Next i
End With
Application.DisplayAlerts = True
End Sub

Muchas gracias estimado, efectivamente borra las hojas que no están en la lista no obstante, también son borradas las "Hojas 1" y "Formato" quisiera evitar esto ultimo, una vez más agradecería tu ayuda.

En efecto borra hoja1, la hoja formato la oculta supongo que por las instrucciones .visible=true, te paso el código con las modificaciones

Sub CREAR()
Application.DisplayAlerts = False
Set datos = Sheets("formato").Range("a2").CurrentRegion
For Each hoja In Worksheets
    nombre = UCase(hoja.Name)
    If nombre <> "HOJA1" Then
        cuenta = WorksheetFunction.CountIf(datos, nombre)
    If cuenta = 0 Then Sheets(nombre).Delete
    End If
Next hoja
With datos
    f = .Rows.Count
    For i = 1 To f
        nombre = .Cells(i, 1)
        If nombre = vbNullString Then GoTo otro
        On Error Resume Next
                With Sheets("formato")
                    .Visible = True
                    .Copy After:=Worksheets(Worksheets.Count)
                    On Error Resume Next
                    ActiveSheet.Name = nombre
                    If Err.Number = 1004 Then ActiveSheet.Delete: GoTo otro
                    .Visible = False
                End With
        On Error GoTo 0
otro:
    Next i
End With
Application.DisplayAlerts = True
End Sub
Respuesta
1

Quizás esto aporte algo más

https://youtu.be/pVsqucqK6DY 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas