Como extraer filas con condición de una hoja de Excel y copiarlas en otras hojas.
Hoja1) con mucha data son 1,400 filas en 8 columnas que tiene encabezados. Lo que quiero es que cuando le de click en un botón copie todas las filas que tengan el mismo número de la columna A (A2:A1400 son códigos hay varios) en la columna A1:H1 están los encabezados que también quiero que los copie en otra hoja, pero solo quiero que los filtre si los códigos cumplen y que además copie los códigos,
Y para terminar quiero por cada código cree una hoja nueva y esa hoja tendrá como nombre el numero del código quiero que se cree tantas hojas como códigos encuentre.
H o l a:
Puedes enviarme un correo nuevo con lo siguiente:
- Un archivo con 4 hojas.
- La primer hoja con las columnas originales..
- En las hojas 2, 3 y 4, tienes que poner ejemplos de cómo quieres los resultados, en estas hojas deberás poner los datos que están en la hoja1.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “jorge romero” y el título de esta pregunta.
Te anexo la macro
Sub GenerarHojas()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("BASE DATOS")
Set h2 = l1.Sheets("Temp")
Call BorrarHojas
'
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h2.Cells.Clear
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
'
h1.Columns("H").Copy h2.[A1]
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
'
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
With h2.Sort
.SortFields.Clear
.SortFields.Add Key:=h2.Range("A2:A" & u2), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h2.Range("A1:A" & u2): .Header = xlYes: .MatchCase = False
.Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
End With
'
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A1:H" & u1).AutoFilter Field:=8, Criteria1:=h2.Cells(i, "A")
h1.Range("A1:J" & u1 + 3).Copy
Set h3 = Sheets.Add(after:=Sheets(Sheets.Count))
h3.[A1].PasteSpecial xlValues
h3.[A1].PasteSpecial xlFormats
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Rows(u3).Delete
h3.Name = h2.Cells(i, "A")
Next
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h1.Range(h1.Cells(u1 + 2, "I"), h1.Cells(u1 + 3, "J")).Clear
h1.Select
Application.ScreenUpdating = False
MsgBox "Fin"
End Sub
'
Sub BorrarHojas()
'Por.Dante Amor
Application.DisplayAlerts = False
For h = Sheets.Count To 3 Step -1
Sheets(h).Delete
Next
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Gracias amigo me servio de muco ahora otro reto que me están pidiendo
Es tanto de la columna debe y de la columna haber me haga una sumatoria eso seria en la siguiente fila en la misma columna la suma del debe y del haber
Y que adema me sace la diferencia, espero su ayuda por favor
H o l a:
Pero tienes que crear una nueva pregunta en el tema de microsoft excel. 
