Copiar rango según condición de otra hoja
Saludos y buen día a todos
Solicito su apoyo para una macro que realice lo siguiente
Tengo la hoja1 con los títulos de la A3:AE3
En la hoja2 los titulos estan en A2:AZ2
La macro debe buscar A3 el titulo en la hoja2 y si lo encuentra debe cortar de la hoja1 rango A4:A1000 y pegar en la columna de la hoja2 donde se encuentra el titulo y así sucesivamente, las columnas son variables donde se encuentran los títulos y en la hoja1 nunca se encuentran los títulos en la misma columna
Hoja1
Fila Columna A Columna B ColumnaC ... Columna AE
1 xxxxxx
2xxxxxxxxxxxxx
3 Ventas Compras Merma Devolucion
4 1000.12 7634.20 -12.12 0.00
5 5000.00 0.00 0.00 250.50
1000 6700.60 4500.10 0.00 0.00
Nota.- En la hoja1, no siempre se va a encontrar ventas en ColA, Compras en ColB, merma en ColC Devolución en AE, si no que a veces pueden estar todos estos conceptos en diferente columna, en otros casos puede que no exista algún concepto, y puede haber nuevos conceptos por eso opto por cortar y pegar para que me pueda dar cuenta si hay un nuevo titulo que no este en la hoja2
Buscar en hoja2 cortar y pegar los valores de hoja1 en donde corresponda, la hoja2 debe quedar en este caso así
Hoja2
Fila Columna G Columna J Columna Y .... Columna AZ
1 xxxxxx
2 Merma Devolucion Compras Ventas
3 -12.12 0.00 7634.20 1000.12
4 0.00 250.50 0.00 5000.00
1000 0.00 0.00 4500.10 6700.60
Agradezco de antemano sus comentarios, tiempo y apoyo
Saludos
1 Respuesta
Esta es la macro
Sub copiar()
'Por.DAM
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
For i = 1 To h2.Cells(2, Columns.Count).End(xlToLeft).Column
Set b = h1.Rows(3).Find(h2.Cells(2, i))
If Not b Is Nothing Then
u = h1.Cells(Rows.Count, b.Column).End(xlUp).Row
h1.Range(h1.Cells(4, b.Column), h1.Cells(u, b.Column)).Copy
h2.Cells(3, i).PasteSpecial Paste:=xlValues
End If
Next
MsgBox "Copia terminada", vbInformation
End SubCambia en la macro "Hoja1" y "Hoja2", por los nombres de tus hojas.
