Prueba esta macro,
Option base 1
sub copiar_datos()
dim funcion as worksheetfunction
set h1 = worksheets("ingdevoluciones")
set h2 = worksheets("tabladevoluciones")
set funcion = worksheetfunction
with h1
rif = .range("i5"): mes = .range("k5")
valor = rif & "-" & mes
set destino = h1.range("h7").currentregion
end with
with destino
dr = .rows.count: dc = .columns.count
end with
with h2
set datos = h2.range("a7").currentregion
with datos
.sort key1:=h2.range(.columns(4).address), order1:=xlascending
c = .columns.count: r = .rows.count
set tabla = .columns(c + 3).resize(r, 1)
crif = .cells(1, 2).address(false, false)
cmes = .cells(1, 12).address(false, false)
with tabla
.columns.formula = "=" & crif & "&""-""&" & cmes
cuenta = funcion.countif(tabla, valor)
fila = funcion.match(valor, tabla, 0)
end with
set origen = .rows(fila).resize(cuenta, c)
redim matriz(cuenta, destino.columns.count)
for i = 1 to cuenta
matriz(i, 1) = origen.cells(i, 1)
matriz(i, 2) = origen.cells(i, 4)
matriz(i, 3) = origen.cells(i, 11)
matriz(i, 4) = origen.cells(i, 6)
matriz(i, 5) = origen.cells(i, 7)
matriz(i, 6) = origen.cells(i, 8)
matriz(i, 7) = origen.cells(i, 10)
matriz(i, 8) = origen.cells(i, 13)
next i
end with
with destino
h1.range(.rows(dr + 1).resize(cuenta, dc).address) = matriz
.currentregion.columns.autofit
end with
end with
tabla.clearcontents
erase matriz
set destino = nothing: set origen = nothing: set datos = nothing
set funcion = nothing: set h1 = nothing: set h2 = nothing
end sub