Crear n tablas con valores de una columna
Hola espero me puedan ayudar gracias.
tengo el siguiente código el cual busca valores en la columna A de la hoja1, toma el nombre de ese valor crea una nueva hoja con ese valor y pega todo lo que encontró en la columna A de la hoja1 en la nueva hoja.
Por ejemplo en la columna A de la hoja1 tengo los nombres corro la macro y busca todos los valores que pongo en el cuadro de texto Eduardo y copia todos los valores que sean eduardo automáticamente crea una nueva hoja llamada eduardo y pega automáticamente los valores que encontró en la hoja1 en la hoja eduardo.
Lo que quiero es un botón para que cree tablas con todos los valores de la columna A de lahoja1por decir si tengo en la columna A de la hoja1 eduardo, juan, pablo.. Cuando le de clic al botón crea las tablas para cada uno y pega sus valores que están en la columna A de la hoja1
Sub copiar_y_mover()
columna = Range("bz1").End(xlToLeft).Column
quebusco = InputBox("Ingrese el dato que desea buscar.")
If quebusco = "" Then Exit Sub
ActiveSheet.Range("a1").CurrentRegion.Sort Key1:=Range("a1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set busca = ActiveSheet.Range("a1:a" & Range("a1000000").End(xlUp).Row).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Range(ubica).Select
valor = ActiveCell.Value
fila = ActiveCell.Row
contarsi = Application.WorksheetFunction.CountIf(Columns(1), valor)
Range(Cells(fila, 1), Cells(fila + contarsi - 1, columna)).Copy
Application.ScreenUpdating = False
If quebusco = "" Then Exit Sub
For Each hoja In ThisWorkbook.Worksheets
If quebusco = hoja.Name Then
MsgBox "Ya existe una hoja con ese nombre."
'*********
Exit Sub
End If
Next
Dim Hoja1 As Worksheet
Set Hoja1 = ActiveWorkbook.Sheets.Add
Hoja1.Name = quebusco
Application.ScreenUpdating = True
'***********************
Range(Cells(fila, 1), Cells(fila + contarsi - 1)).PasteSpecial xlPasteAll
Application.CutCopyMode = False
End If
End Sub
1 respuesta
Pon en un botón esta macro:
Sub nombres()
'Por.DAM
Set h1 = ActiveSheet
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
existe = False
For Each h In Sheets
If h.Name = h1.Cells(i, "A") Then
h1.Rows(i).Copy h.Range("A" & h.Range("A" & Rows.Count).End(xlUp).Row + 1)
existe = True: Exit For
End If
Next
If existe = False Then
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
h2.Name = h1.Cells(i, "A")
h1.Rows(i).Copy h2.Range("A1")
End If
Next
End Sub Saludos.Dante Amor
Si es lo que necesitas.
Gracias por responder
Me marca error 1004
h2.Name = h1.Cells(i, "A")
¿Tienes nombres con más de 30 caracteres o alguno de los nombres tienen caracteres raros?
¿Te creó alguna hoja con nombres o se detuvo en la primera?
se detuvo a la primera y los nombres pueden llevar un número ejemplo avilaj2
¿Tienes protegido el libro o con hojas ocultas?
O envíame tu archivo y lo reviso
ya te lo mande.
espero me puedas ayudar gracias.
Te envié el archivo
No olvides finalizar la pregunta
