Nuevas hojas desde Vba

[davidhelios]

Hola a todos de nuevo!

Vamos a ver si esta vez alguien me puede ayudar con esto que me ha atascado de nuevo.

Tengo una hoja de excel que contiene una lista de nombres y necesito que Vba me cree una hoja correspondiente a cada registro. He visto que eso se puede hacer pero el problema es que si introduzco el código en el evento open del libro, me crea las hojas cada vez que lo habro y si ya existen me deja el nombre de la hoja por defecto. Había pensado en crear cada hoja manualmente y olvidarme pero, el número de registros aumenta periódicamente y es tedioso crear cada hoja y dar formato a cada campo para que se queden iguales todas. Sin pasar por alto que se me podría olvidar crear alguna hoja nueva si se introducen demasiados registros nuevos.

Hablando claro, ¿alguien sabría decirme un código que lea la lista y reconozca si existe una hoja con ese nombre? en cuyo caso me gustaría que creara una para cada registro nuevo que se haya introducido desde la ultima vez. Algo asi como un código que cree una hoja por cada registro encontrado y valide si dichos registros ya tienen alguna hoja asignada al mismo nombre.

Dar formato a cada hoja es lo de menos porque he pensado en crear un módulo sencillo que lo haga y solo tendría que ejecutarlo o llamarlo desde cualquier linea de código, pero lo anterior me lleva de cabeza.

Muchas gracias a todos. y un saludo

 

[Greg Truby]

Bueno, lo que pongo aquí hice rapidito mientras almuerzo. Pero por lo menos debe darle unas ideas sobre como solucionar su problema. Se supone que su listado de nombres tiene una fila que sirve como cabeza y está en la celda A1 en la primera hoja. Usted tendría que hace los ajustes para que corresponda a la situación actual de usted.

Option Explicit

Private Sub Workbook_Open()


    Dim celItem As Excel.Range, _
        rngList As Excel.Range, _
        wsNew   As Excel.Worksheet
        
    On Error GoTo ErrH
    Set rngList = Me.Worksheets(1).Range("A1").CurrentRegion
    
    With rngList
        Set rngList = .Offset(1).Resize(.Rows.Count - 1)
    End With
    
    For Each celItem In rngList.Cells
        If Not fnWSExists(celItem.Value) Then
            With Me.Worksheets
                Set wsNew = .Add(After:=.Item(.Count))
            End With
            On Error Resume Next
            wsNew.Name = celItem.Value
            If Err.Number <> 0 Then
                MsgBox "Sheet " & wsNew.Name & " was not renamed." & vbCr & vbCr _
                     & "The illegal name was:  " & celItem.Value, vbExclamation, "Illegal Name"
                Err.Clear
            End If
            On Error GoTo ErrH
        End If
    Next celItem


Exit Sub


ErrH:


    MsgBox "Unhandled errors occured while adding sheets", vbExclamation




End Sub


Private Function fnWSExists(ByVal strWSName As String) As Boolean


    Dim ws As Excel.Worksheet
    
    On Error Resume Next
    Set ws = Me.Worksheets(strWSName)
    Err.Clear
    
    Let fnWSExists = Not ws Is Nothing


End Function

Buena suerte,