Copiar Datos con Doble Condición con macros
Hace unos días me apoyaron con un código que me copia datos que cumplen con la condición, los datos se copian desde la hoja Base y se pegan en la hoja Reporte, los datos para la condición están el la columna ("J:J") de la hoja "BASE" y la condición esta en Hoja2("A1"), lo que necesito es que el código me copie los datos si se cumplen con dos condiciones, la segunda condición estaría en Hoja2("A2") y los datos para la condición estarían en la hoja BASE("G:G").
Por ejemplo
Si en la hoja2 Tengo, en "A1" el año = 2019 y en "A2" el mes = 3
Y si en la hoja BASE, tengo en: Columna "J" están los años y en la columna "G" los meses
En otras palabras, si en la Hoja2, en A1 tengo 2019 y en A2 tengo 3, que la macro me copie las filas que cumplen con esa condición
Desde ya muchas Gracias-
Este es el codigo que uso actualmente:
Sub Buscar_Datos_mes()
Sheets("BASE ").Select
filalibre = Sheets("Reporte").Range("J80000").End(xlUp).Row + 1
'Extraemos la Condicion
dato = (Sheets("Hoja2").Range("A1") 'Condición
If dato = "" Then Exit Sub
'Empesamos a buscar el lacelda
Set buscado = ActiveSheet.Range("j1:j" & Range("j80000").End(xlUp).Row).Find(dato, LookIn:=xlValues, LOOKAT:=xlWhole)
If Not buscado Is Nothing Then
'Definimos la Ubicación
ubica = buscado.Address
Do
buscado.EntireRow.Copy Destination:=Sheets("Reporte").Cells(filalibre, 1)
filalibre = filalibre + 1
Set buscado = ActiveSheet.Range("J1:J" & Range("J80000").End(xlUp).Row).FindNext(buscado)
Loop While Not buscado Is Nothing And buscado.Address <> ubica
End If
End Sub
Este es el resultado de la macro, cambie la programación es más rápido hacer la copia mediante filtros que de la manera que la tienes
y esta es la macro
Sub copiar_condicionado()
Set hb = Worksheets("base")
Set h2 = Worksheets("hoja2")
Set hp = Worksheets("reporte")
With hb
filas = .Range("g1").CurrentRegion.Rows.Count
Set datos = .Range("g1").Resize(filas, 4)
End With
With h2
xyear = .Range("a1"): xmes = .Range("a2")
End With
With hp
filas = .Range("g1").CurrentRegion.Rows.Count
End With
With datos
.AutoFilter 4, xyear: .AutoFilter 1, xmes
.Offset(1, 0).Copy
If filas = 1 Then hp.Range("g1").PasteSpecial xlPasteValues
If filas > 1 Then hp.Range("g1").Rows(filas + 1).PasteSpecial xlPasteValues
.AutoFilter
End With
Set datos = Nothing
End Sub
Gracias James
Solo que se me olvido indicar que la macro debe copiar desde "A" hasta "AL"
la que me pasaste solo me copia la columna "G"
Si me pudieras ayudar nuevamente, muchas gracias
La macro la puedo modificar solo requiero una imagen de tus datos cuando programe esta tuve la duda de hasta donde querías que copiara y si tu información tendría áreas vacías.
