Macro para Exportar columnas condicionadas VBA Excel
Expertos reciban un saludo, ingreso por lo siguiente, quisiera hacer una macro que al presionar un botón el evalué una columna si los datos de esa columna cumplen con la condición entonces debe exportar a otra hoja de excel, la columna 3, 7 y 9. Ejemplo tengo 10 columnas en el libro 1 y en la columna 9 tengo una puntuación, si la puntuación es mayor a 200 entonces trae los datos de la misma fila pero de la columna 3, 7 y 9.
2 Respuestas
Otra propuesta de macro utilizando el filtro avanzado:
Sub FILTRO()
' Filtra base de datos por citerios y copia determinadas columnas ya filtradas en otra hoja
'Limpia la hoja 2
Sheets("Hoja2").Cells.Clear
'Recalcula el rango MISDATOS para incorporar nueva información
[MISDATOS].CurrentRegion.Name = "MISDATOS"
'Filtra la base de datos MISDATOS por CRITERIOS
Range("MISDATOS").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("MISCRITERIOS"), Unique:=False
'Copia deteriminadas columnas de MISDATOS
Range("A:A,C:C,F:F").Copy
'Las pega en la hoja 2
Sheets("Hoja2").Select
Range("A1").Select
ActiveSheet.Paste
'Elimina filtro en MISDATOS
Sheets("Hoja1").ShowAllData
End Sub
Al rango de tu base de datos en Hoja1 le asignas el nombre MISDATOS (u otro y se lo cambias en la macro).
Creas un criterio en otra zona de la hoja: en una celda pones un nombre de campo, p.ej. “Puntuación”, en la celda justo inferior el criterio, p.ej. “>200”. (Ver en imagen abajo) A este rango de dos celdas le asignas el nombre MISCRITERIOS.
En este ejemplo las columnas que se traspasan son A, C y F, pero las cambias en la macro a tu necesidad.
Creas un botón en la Hoja1 (ver en imagen abajo) y le vinculas la macro FILTRO. Al presionar se copian las columnas deseadas ya filtradas en la Hoja2.
Saludos
Esta macro hace lo que tú deseas:
Private Sub CommandButton1_Click()
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
uf = h1.Range("A" & Rows.Count).End(xlUp).Row
For f = 1 To uf
If Cells(f, 9) > 200 Then
h1.Range("C" & f & ",G" & f & ",I" & f).Copy
uf2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Range("A" & uf2).PasteSpecial Paste:=xlPasteValues, Transpose:=False
Application.CutCopyMode = False
fil = fil + 1
End If
Next f
MsgBox ("Copiadas " & fil & " filas")
End SubCambia Hoja1 y Hoja2 por los nombres de tus hojas; y crea un botón en la Hoja1. Cuando acabe de copiar te dirá el número de filas copiadas.
Si te ha valido la respuesta.
Buenos días marcial, la macro la estoy probando y me muestra un error y me subraya la línea:
h1.Range("C" & f & ",G" & f & ",I" & f).Copy
¿Qué crees que sea?
¡Gracias! perfecto ya encontré la solución muchas gracias.! éxitos amigos gracias por la ayuda Miguel Guzmán Romero Marcial C. C.