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:
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:
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':
El resultado sería:
...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:
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:
Muy interesante y práctico como siempre.
ResponderEliminarGracias Ismael.
Gracias!
Eliminar