0

Contexto:
En una hoja de cálculo se tiene una columna de información donde se hallan diferentes nombres los cuales se ubican en una pestaña de nombre [lista]. Tomar de referencia el siguiente caso simplificado:

CABECERA (no cuenta)
ROGER
CECILIO
BRAUN
JOEL
JULIO
ASTOR

La hoja de cálculo además de la pestaña [lista] posee otras pestañas adicionales. Tomar de referencia todas las pestañas de la hipotética hoja de cálculo:

[ lista ][ astor ][ roger ][ awgz ]

Problema:
A partir de los valores contenidos en la columna de información simplificada, crear pestañas con los nombres que faltan. Como ya existe la pestaña [astor] y [roger], se debería crear las pestañas [cecilio], [braun], [joel] y [julio].

Para este problema he utilizado la construcción For Each In iterando sobre cada celda para crear una pestaña, pero cuando iteraba, por ejemplo, en ROGER me salía un error y mi código se paralizaba, dado que ya existía una pestaña con ese nombre. Ante ello, recurrí al On Error Resume Next, pues pensé que si ya había una pestaña con ese nombre, no se crearía ninguna pestaña adicional. Sin embargo, se generaron pestañas adicionales aunque con nombre genérico tipo "Hoja2", "Hoja3", etc. ¿Cómo podría modificar mi código para que agregue pestañas con los nombres que faltan de acuerdo a la columna de información simplificada?

   Dim _
   fname As String, _
   a1 As Range, arange As Range, _
   cell As Range

   fname = "archivo.xlsx"
   ChDir (ThisWorkbook.Path)
   Workbooks.Open Filename:=fname

   Set a1 = Workbooks(fname).Worksheets("lista").Range("A1")

   With a1
       Set arange = Range(.Offset(1,0), .End(xlDown))  
   End with

   For Each cell In arange
       On Error Resume Next
       Workbooks(fname).Sheets.Add(After:=Sheets(Sheets.Count)).name = cell.value    
   Next

1 respuesta 1

2

Esto debería servirte, aunque haga un par de bucles debería funcionar muy rápido.

Option Explicit
Sub Test()

    Dim Archivo As String: Archivo = "archivo.xlsx"
    Dim wb As Workbook: Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Archivo)

    'Creamos un diccionario que contenga los nombres de las hojas existentes
    Dim hojasExistentes As Object: Set hojasExistentes = CreateObject("Scripting.Dictionary")
    Dim ws As Worksheet
    hojasExistentes.CompareMode = TextCompare
    For Each ws In wb.Worksheets
        hojasExistentes.Add ws.Name, 1
    Next ws

    'Creas las hojas nuevas
    With wb.Sheets("Lista")
        Dim lrow As Long: lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim cell As Range
        For Each cell In .Range("A2:A" & lrow)
            'Este condicional comprueba si tu celda ya existe como hoja, si no, crea la hoja.
            If Not hojasExistentes.Exists(cell.Value) Then _
                wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = cell.Value
        Next cell
    End With

End Sub

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.