Para AnGeLo

Hola paco, esperemos q alguno de los expertos te conteste, ya q yo el codigo
q te pase, lo copie como te habia comentado de KL, yo no estoy muy práctico
en eso, asi q por ahi alguien te contestara.


Saludos,

Angelo Vernaza
"La única vez que me eh equivocado, fue cuando pensé que me habia
equivocado"

"paco" escribió en el mensaje
news:

Hola Angelo!
el día 19/05/2005 pregunte sobre como contar hojas, gracias de antemano

por

tu ayuda. el codigo que me proporcionaste me determina en una lista el

nombre

de las hojas que tengo, lo que deseo hacer es lo inverso, es decir, de una
lista previamente capturada, que agregue "n" hojas con como tantos nombres
haya en lista, y que ademas le asigne ese nombre.

Supongamos que tengo mi lista en una única hoja, que es hoja1
Clientes
Proveedores
Productos
Rutas, etc.

en este caso, que se adicionen 4 hojas y cada una le ponga el nombre
clientes, proeveedores y asi sucesivamente hasta terminar con la lista.


Gracias por tu ayuda

atte. Paco

Hola Paco,

Prueba este codigo que tienes que colocar en el modulo de la hoja donde esta
la lista. Para ello:

1) Haz clic-derecho sobre el nombre de tu hoja en una de las pestañas de la
parte de abajo de la ventana de Excel.
2) Elige la opcion Ver Codigo para abrir el editor VBA.
3) En la ventana mas grande a la derecha pega el codigo que te pongo a
continuacion.
4) Ahora pulsa Alt+F11 para volver a la hoja.
5) Prueba introducir texto en el rango [A1:A20]

Ojo - el codigo esta diseñado para eliminar las hojas que no esten en la
lista (excepto la de la lista) sin preguntar.

Saludos,
KL

'inicio codigo
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim hoja
Dim rng As Range
Dim celda As Range
Dim i As Long

'Establecemos el rango d la lista
Set rng = Me.Range("A1:A20")
Set wb = ThisWorkbook

'Comprobamos si ha cambiado la lista
If Intersect(Target, rng) Is Nothing Then Exit Sub

'Congelamos la pantalla
Application.ScreenUpdating = False

'Eliminamos las hojas que ya no estan en la lista
For Each hoja In wb.Sheets
If hoja.Name <> Me.Name And _
rng.Find(hoja.Name) Is Nothing Then
Application.DisplayAlerts = False
hoja.Delete
Application.DisplayAlerts = True
End If
Next hoja

'Creamos hojas con nombres de la lista
For Each celda In rng
If Not IsEmpty(celda) And NombreUnico(celda.Value) And _
NombreValido(celda.Value) Then
wb.Worksheets.Add(After:= _
wb.Worksheets(Worksheets.Count)).Name = celda.Value
End If
Next celda
Me.Select
Application.ScreenUpdating = True
End Sub

Function NombreValido(Nombre As String) As Boolean
Dim CarInvalidos As Variant
Dim i As Long
CarInvalidos = Array(":", "\", "/", "?", "*", "[", "]")
For i = 0 To UBound(CarInvalidos)
If InStr(Nombre, CarInvalidos(i)) Then
MsgBox "El nombre " & Nombre _
& " contiene caracteres invalidos (" _
& CarInvalidos(i) & ")."
NombreValido = False
Exit Function
End If
Next i
NombreValido = True
End Function

Function NombreUnico(Nombre As String) As Boolean
Dim hoja
For Each hoja In ThisWorkbook.Worksheets
If hoja.Name = Nombre Then
NombreUnico = False
Exit Function
End If
Next hoja
NombreUnico = True
End Function
'Fin codigo

Muchas gracias Angelo y KL
Saludos.

"KL" escribió:

Hola Paco,

Prueba este codigo que tienes que colocar en el modulo de la hoja donde esta
la lista. Para ello:

1) Haz clic-derecho sobre el nombre de tu hoja en una de las pestañas de la
parte de abajo de la ventana de Excel.
2) Elige la opcion Ver Codigo para abrir el editor VBA.
3) En la ventana mas grande a la derecha pega el codigo que te pongo a
continuacion.
4) Ahora pulsa Alt+F11 para volver a la hoja.
5) Prueba introducir texto en el rango [A1:A20]

Ojo - el codigo esta diseñado para eliminar las hojas que no esten en la
lista (excepto la de la lista) sin preguntar.

Saludos,
KL

'inicio codigo
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim hoja
Dim rng As Range
Dim celda As Range
Dim i As Long

'Establecemos el rango d la lista
Set rng = Me.Range("A1:A20")
Set wb = ThisWorkbook

'Comprobamos si ha cambiado la lista
If Intersect(Target, rng) Is Nothing Then Exit Sub

'Congelamos la pantalla
Application.ScreenUpdating = False

'Eliminamos las hojas que ya no estan en la lista
For Each hoja In wb.Sheets
If hoja.Name <> Me.Name And _
rng.Find(hoja.Name) Is Nothing Then
Application.DisplayAlerts = False
hoja.Delete
Application.DisplayAlerts = True
End If
Next hoja

'Creamos hojas con nombres de la lista
For Each celda In rng
If Not IsEmpty(celda) And NombreUnico(celda.Value) And _
NombreValido(celda.Value) Then
wb.Worksheets.Add(After:= _
wb.Worksheets(Worksheets.Count)).Name = celda.Value
End If
Next celda
Me.Select
Application.ScreenUpdating = True
End Sub

Function NombreValido(Nombre As String) As Boolean
Dim CarInvalidos As Variant
Dim i As Long
CarInvalidos = Array(":", "\", "/", "?", "*", "[", "]")
For i = 0 To UBound(CarInvalidos)
If InStr(Nombre, CarInvalidos(i)) Then
MsgBox "El nombre " & Nombre _
& " contiene caracteres invalidos (" _
& CarInvalidos(i) & ")."
NombreValido = False
Exit Function
End If
Next i
NombreValido = True
End Function

Function NombreUnico(Nombre As String) As Boolean
Dim hoja
For Each hoja In ThisWorkbook.Worksheets
If hoja.Name = Nombre Then
NombreUnico = False
Exit Function
End If
Next hoja
NombreUnico = True
End Function
'Fin codigo