Crear una tabla B a partir de una rabla A con datos filtrados

Con mucho trabajo he logrado crear esta macro pero la macro en si presenta un error como puede observar esta es la tabla resultante de la consulta rif111111111 del mes septiembre, en la tabla general existen 2 registros con estas condiciones (reg 1 y reg 4)la macro cuenta que hay 2 efectivamente mostrándome el reg4 que corresponde (abajo esta la tabla principal), pero me pone en seguidilla los demás registros cualesquiera tanta veces como este el rif111111111 con septiembre,(en la tabla principal esta 2 veces), debiendo mostrar el registro 4 y el registro 1

La tabla resultante le siguen los siguientes campos cant-motivo-status-fecha acuse recibo, por ser tal larga la imagen la acorte hasta descripción, todo esta perfecto lo único es que me muestra los reistros que no son cuando hay más de uno, esta tabla resultante esta en otra hoja. Anteriormente le he hecho otras consultas creo tener su correo, si usted lo pide le puedo enviar el archivo.

Tabla principal (la tabla completa le siguen los siguientes campos cant-monto total-motivo-fecha proceso-mes-status-fecha acuse recibo, por motivo de ser tan larga la imagen la acorte hasta descripción)

Esta es la macro que estoy utilizando, le hice algunas adaptaciones.

Sub copiar_datos()

Worksheets("regdevoluciones").Range("h8:q19").ClearContents

Dim funcion As WorksheetFunction
Set h1 = Worksheets("regdevoluciones")
Set h2 = Worksheets("tabladevoluciones")
Set funcion = WorksheetFunction

With h1
rif = .Range("J5"): mes = .Range("M5")
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, 5)
matriz(i, 4) = origen.Cells(i, 11)
matriz(i, 5) = origen.Cells(i, 6)
matriz(i, 6) = origen.Cells(i, 7)
matriz(i, 7) = origen.Cells(i, 8)
matriz(i, 8) = origen.Cells(i, 10)
matriz(i, 9) = origen.Cells(i, 13)
matriz(i, 10) = origen.Cells(i, 14)
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

Bueno amigo espero haber detallado un poco claro el problema.

1 respuesta

Respuesta

Si la macro tiene un error, para corregir la macro o para crear una nueva macro, necesito saber qué tienes y qué esperas de resultado.

Puedes poner imágenes de tus hojas, procura que se vean las filas y las columnas de excel.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas