Macro para excel. ¿Cómo extraer datos que cumplan una condición y copiarlos en otra hoja, con modificaciones?
Tengo 2 hojas: BÚSQUEDA y PRESUPUESTO
1. Debo extraer de "Búsqueda", las líneas que en la columna "I" tenga el valor "SI"
2. Copiar estos datos en "Presupuesto" siguiendo la siguiente orrespondencia de columnas: A en A, B en B, C en C, H en D. Las otras, se descartan.
3. En la hoja "Presupuesto", la fila del "total" debería adaptarse a la cantidad de filas copiadas
Sergio Luis,
Adjunto enlace el archivo excel para el desarrollo de tu consulta para su revisión.
Sub ExtraerDatosTabla()
Worksheets("PRESUPUESTO").Range("A1:W100").Clear
Set Rango = Worksheets("BUSQUEDA").Range("A1").CurrentRegion
x = 2: suma = 0
Sheets("PRESUPUESTO").Select
For j = 1 To 3
Cells(1, j) = Rango.Cells(1, j)
Next j
Cells(1, 4) = Rango.Cells(1, 7)
Cells(1, 5) = Rango.Cells(1, 8)
For i = 2 To Rango.Rows.Count
If Rango.Cells(i, Rango.Columns.Count) = "SI" Then
Cells(x, 1) = Rango.Cells(i, 1)
Cells(x, 2) = Rango.Cells(i, 2)
Cells(x, 3) = Rango.Cells(i, 3)
Cells(x, 4) = Rango.Cells(i, 7)
Cells(x, 5) = Rango.Cells(i, 8)
suma = suma + Cells(x, 5)
x = x + 1
End If
Next i
Cells(x + 1, 3) = "TOTAL"
Cells(x + 1, 5) = suma
Range("A1:E1,A" & x + 1 & ":E" & x + 1).Interior.ThemeColor = xlThemeColorAccent2
Range("A1:E1,A" & x + 1 & ":E" & x + 1).HorizontalAlignment = xlCenter
Range("A1:E1,A" & x + 1 & ":E" & x + 1).VerticalAlignment = xlCenter
Range("A1:E1,A" & x + 1 & ":E" & x + 1).Font.Bold = True
Columns("A:E").EntireColumn.AutoFit
Range("A2:B" & x - 1).HorizontalAlignment = xlCenter
Range("D2:E" & x - 1 & ",E" & x + 1).NumberFormat = "[$$-409]#,##0.0"
Range("C" & x + 1).HorizontalAlignment = xlRight
End SubEspero que te sirva y este acorde de tu necesidad. Cualquier consulta estaré pendiente.
Extraer datos a partir de una condición
Ander GS.
1 respuesta más de otro experto
Prueba con esta macro
Sub COPIAR()
Set H1 = Worksheets("HOJA1")
Set H2 = Worksheets("HOJA2")
Set DATOS = H1.Range("A9").CurrentRegion
With DATOS
FILAS = .Rows.Count: COLUMNAS = .Columns.Count
.Sort KEY1:=H1.Range(.Columns(COLUMNAS).Address), ORDER1:=xlDescending, Header:=XLTRUE
CUENTA = WorksheetFunction.CountIf(.Columns(COLUMNAS), "SI") + 1
End With
H2.Range("A9").CurrentRegion.Clear
Set DESTINO = H2.Range("A9").Resize(CUENTA, COLUMNAS)
With DESTINO
.Columns(1).Resize(CUENTA, 3).Value = _
DATOS.Columns(1).Resize(CUENTA, 3).Value
.Columns(4).Resize(CUENTA, 1).Value = _
DATOS.Columns(7).Resize(CUENTA, 1).Value
.Cells(2, 5).Resize(CUENTA - 1, 1).Formula = "=B10*D10"
.Cells(CUENTA + 2, 5).Formula = "=SUM(" & .Columns(5).Address & ")"
.Cells(CUENTA + 2, 5).Font.Bold = True
.Cells(CUENTA + 2, 4) = "TOTAL"
.Cells(CUENTA + 2, 4).Font.Bold = True
.Cells(1, 5) = "TOTAL"
.Rows(1).Font.Bold = True
End With
End Sub
¡Gracias!
¡Excelente 007 ! Muy agradecido ! Saludos
Hola, James!! ¿Cómo estás?. Si no es mucho abuso ¿podrías decirme como agregar color en la fila del total (de columna A a E) como en la fila de títulos?
Muchas gracias, Sergio
Solo agrega las líneas que están en el recuadro, eso debe pintar los encabezados, teclea en google colorindex.vba y ya que tengas los resultados te vas a imágenes para conseguir la lista con las claves de los colores de hay seleccionas el que más te agrade y cambias es 22 por el numero de código del color que seleccionaste.
Hola James !! ¿Cómo estás? Yo molestando de nuevo. Intenté hacerle una pequeña modificación a esta macro pero me da algún error al copiar los valores. Lo que necesito es que en la hoja 2, pegue los datos a partir de la celda 12 y no en la 9. Modifique la celda de destino, pero sin duda con eso no es suficiente.. Salusdos
Eso ya es otra consulta, ponla como una consulta aparte y pon además el código con las modificaciones que le has hecho a la macro y de ser posible una pantalla de los datos que quieres copiar y una pantalla del resultado que esperas.