miércoles, 28 de enero de 2015

VBA: Evitar nombres de hojas duplicados en Excel.

Al hilo de una entrada anterior (ver) un lector preguntaba por la forma de ir generando hojas con nombres no duplicados, siguiendo una autonumeración:
...cómo hacer si tengo registros repetidos en la hoja origen que hace que el programa falle porque ya tiene una hoja con ese nombre,, pero necesito que si existe una hoja con ese nombre le ponga un _2 o un _3 y siga...


La idea es que a partir de un listado de una hoja de Excel ir generando las diferentes hojas, y en caso de repetición, añadirles un autonumérico:

VBA: Evitar nombres de hojas duplicados en Excel.



El trabajo consiste en generar una Function ('ExisteHoja') que determine si existe o no una hoja en nuestro libro de trabajo con el nombre nuevo a generar.
Esta Function la emplearemos en el procedimiento Sub 'CrearHojas', donde recorremos el rango de la hoja de cálculo con los nombres a dar, y con el que conseguimos ir renumerando aquellas hojas iguales...


Insertamos y ejecutamos el siguiente procedimiento 'CrearHojas':

Sub CrearHojas()
Dim HojaOrigen As Worksheet, HojaNueva As Worksheet
Set HojaOrigen = Sheets("origen")

'para recorrer los 11 registros del listado
For i = 1 To 11
    'duplicamos la Hoja 'modelo'
    Sheets("modelo").Copy after:=Worksheets(Worksheets.Count)
    Set HojaNueva = Sheets(Worksheets.Count)
    nombrehoja = Worksheets("origen").Cells(7 + i, 4).Value

    If ExisteHoja(CStr(nombrehoja)) = True Then
        x = x + 1
        If ExisteHoja(nombrehoja & "_" & x) = True Then
            y = y + 1
            'damos nombre a la hoja cuando existe duplicidad...
            HojaNueva.Name = nombrehoja & "_" & y
        Else
            HojaNueva.Name = nombrehoja & "_" & x
        End If
    Else
        'damos nombre a la hoja si no existiera
        HojaNueva.Name = nombrehoja
        x = 1: y = 1
    End If

Next i
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ExisteHoja(Nombre As String, Optional Libro As Workbook)
Dim sh As Worksheet
'controlamos el argumento Opcional
'que identifica el Libro donde Buscar...
If Libro Is Nothing Then Set Libro = ThisWorkbook

'controlamos la existencia de la hoja
'si tuvieramos un error es que existe...
On Error Resume Next
Set sh = Libro.Sheets(Nombre)
On Error GoTo 0

ExisteHoja = Not sh Is Nothing
End Function



El resultado sería:

VBA: Evitar nombres de hojas duplicados en Excel.

2 comentarios: