Agregar un hoja automatica segun fila

Esto lo logras con BUSCARV. Si alguna dificultad en aplicarla,comentas para
ampliar la respuesta.

Cordialmente
Luis Caro

No somos 3.Quitar NOSPAMEPM.Poner epm.y el resto
http://usuarios.lycos.es/maderascolombianas2/
http://www.geocities.com/maderascolombianas2002

Hola Carlos,

Prueba este codigo que tienes que colocar en el modulo de la hoja donde
esta(ra)
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 y la que se tiene que copiar) sin preguntar.

El macro asume que la hoja a copiar se llama "Hoja2", si no es asi cambia el
nombre en el codigo

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
HojaCopiar = "Hoja2"
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 hoja.Name <> HojaCopiar _
And rng.Find(hoja.Name) Is Nothing Then
Application.DisplayAlerts = False
hoja.Delete
Application.DisplayAlerts = True
End If
Next hoja

'Creamos copias usando los nombres de la lista
For Each celda In rng
If Not IsEmpty(celda) And NombreUnico(celda.Value) And _
NombreValido(celda.Value) Then
wb.Sheets(HojaCopiar).Copy _
After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.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.Sheets
If hoja.Name = Nombre Then
NombreUnico = False
Exit Function
End If
Next hoja
NombreUnico = True
End Function
'Fin codigo

Hola amigo KL soy Carlos que me ayudaste por el macro, gracias por la ayuda
todo salio bien, necesito una cosa mas cuando elimino algo de la lista es
automático que elimina la hoja del mismo nombre hasta allí es perfecto,
Quero tener un seguro para eliminar la hoja es como una pregunta antes si
Quero eliminar la hoja antes de eliminarla, y haber si te agrego a mi
Messenger para chatiar con usted online. mi e mail de messenger es
para que me ayuda mas en una hoja de
Excel que estoy hacion, es en la hoja que me haciste el macro quero anotar
los nombre para que me creas la hoja que quero desde A1 Hasta A20 yo voy a
notar los nombre, y frente de clumna a quero notar el telefono de cada uno,
quero desirle que en A1 se llama pedro B1 6952155 es el numero telf de
(pedro) pero quero desirle B1 copiarlo en la hoja (pedro) en la celda D3, y
en la C1 es Email que me lo copias en la hoja (pedro) en la celda D5, asi
cuando modefico en la hoja1 algun datos se modefica en cada hoja que creiado
segun la lista


gracias
KM



"KL" escribió en el mensaje
news:

Hola Carlos,

Prueba este codigo que tienes que colocar en el modulo de la hoja donde
esta(ra)
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 y la que se tiene que copiar) sin preguntar.

El macro asume que la hoja a copiar se llama "Hoja2", si no es asi cambia
el nombre en el codigo

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
HojaCopiar = "Hoja2"
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 hoja.Name <> HojaCopiar _
And rng.Find(hoja.Name) Is Nothing Then
Application.DisplayAlerts = False
hoja.Delete
Application.DisplayAlerts = True
End If
Next hoja

'Creamos copias usando los nombres de la lista
For Each celda In rng
If Not IsEmpty(celda) And NombreUnico(celda.Value) And _
NombreValido(celda.Value) Then
wb.Sheets(HojaCopiar).Copy _
After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.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.Sheets
If hoja.Name = Nombre Then
NombreUnico = False
Exit Function
End If
Next hoja
NombreUnico = True
End Function
'Fin codigo