Macro para leer una tabla y crear una nueva con datos condicionados
Tengo una base de datos principal (hoja1), y en la hoja2 tengo una consulta que tienen los siguientes requerimiento rif y mes, necesito una macro para que lea toda la tabla principal y me vaya extrayendo uno a uno las líneas de datos que correspondan con dicho rif y mes y me llene una nueva tabla en la hoja2 con esos datos, en una línea determinada.
1 respuesta
Como tu explicación esta muy ambigua y una línea determinada puede ser cualquier determinada línea, te paso un ejemplo para que te sirva de base en tu idea, en hoja 1 a falta de ejemplo improvise uno, puse RIF en la columna A y meses en la columna B, en la hoja en la celda B1 puse el RIF a buscar y el mes en la celda C1, la macro una vez que corra va a buscar todos los datos que coincidan y los va a ir copiando a partir de la celda B4, si encuentra 1 o 10 datos que coincidan con ambas condiciones esos 10 datos serán copiados en un solo paso.
esta es la macro
Sub copiar()
Dim funcion As WorksheetFunction
Set h1 = Worksheets("hoja1")
Set h2 = Worksheets("hoja2")
Set funcion = WorksheetFunction
Set origen = h1.Range("a1").CurrentRegion
Set destino = h2.Range("b4").CurrentRegion
With h2
rif = .Range("b1"): mes = .Range("c1")
End With
With origen
c = .Columns.Count
.Sort key1:=h1.Range(.Columns(1).Address), order1:=xlAscending, _
key2:=h1.Range(.Columns(1).Address), order1:=xlAscending, Header:=xlYes
cuenta_rif = funcion.CountIf(.Columns(1), rif)
fila_rif = funcion.Match(rif, .Columns(1), 0)
Set rifs = .Rows(fila_rif).Resize(cuenta_rif)
With rifs
cuenta_mes = funcion.CountIf(.Columns(2), mes)
fila_mes = funcion.Match(mes, .Columns(2), 0)
.Rows(fila_mes).Resize(cuenta_mes).Copy
End With
End With
With destino
rd = .CurrentRegion.Rows.Count
.Rows(rd + 1).Resize(cuenta_mes, c).PasteSpecial
End With
Set origen = Nothing: Set destino = Nothing
Set h1 = Nothing: Set h2 = Nothing: Set funcion = Nothing
End Sub
Buen día amigo lo de la línea determinada era de donde me va a empezar a copiar los datos, no me supe explicar, pero si determino mi idea ya que lo que me indica es lo que pretendo hacer, voy a analizar la macro y a desarrollarla, lo que si quisiera es que tomara ciertos datos cuando genere la tabla 2, por ejemplo la tabla principal tiene cedula, nombre, edad, sexo, y lo que debe ir a la tabla 2 es solamente cedula y nombre. Pero en general esta excelente el ejemplo, espero su respuesta de esta nueva consulta, cualquier cosa si me tranco en el intento, me comunico con usted de nuevo. Gracias. Nota: no voy a cerrar la consulta todavía. Pero excelente todo. Muchas gracias.
Esa más fácil orietarte si sabes un ejemplo de tus datos no tienen que ser reales lo que ocupo es la estructura por ejemplo puede hacer una tabla así
Ri1, mes1, sexo1, cedula1, clave1
RIF2, mes2, sexo2, cedula2, clave2
Amigo de verdad gracias por su tiempo, pero estoy trancado con la macro le puedo enviar el archivo excel que estoy haciendo, pero como hago para enviarlo, como veo su correo.agradecido.
Por algunas malas experiencias que he tenido ya no doy mi email, lo que puedes hacer es subir tu archivo a google drive y pegar el link aqui o bien como dije subir imagenes de la hoja 1 y la hoja 2 de lo que estas haciendo con cualquiera de los puedo ver que tratas de hacer.
Ok, ya tengo las imágenes, las primeras tres son de la base de datos principal (lo hice en 3 imágenes ya que es muy larga)que empieza desde A7 hasta N7 de N cantidad de líneas hacia abajo ya que se le agregan datos a diario, esta ubicada en la hoja 2 de nombre (tabladevoluciones):
Ahora esta es la tabla resultante de acuerdo a las condiciones ingresadas, como es el rif y el mes, esta en la hoja1 de nombre (ingdevoluciones),
Debe empezar a aparecer los datos en los rangos H a la O en la línea 8 así
Sucesivamente hacia abajo tantas veces como concuerden las condiciones
Y no son todos los datos, si no los que aparecen en esta tabla.
Agradecería inmensamente su ayuda amigo ya que es un proyecto que debo concluir y estoy parado allí, gracias.
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
