Macro que copie rangos de columnas de diferentes hojas a una sola
Deseo una macro que copie rangos de columnas de diferentes hojas a una sola en la columna que yo asigne es decir de la hojas 2 deseo copiar el rango d2:d20 de la hoja 3 deseo copiar el rango f3:f50 estos rangos deseo copiarlos en la hoja 1 en la columna C y que me los vaya acumulando
1 Respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro actualizada para copiar rangos y columnas.
Sub CopiarRangos()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
hojas = Array("Hoja2", "Hoja3", "Hoja4") 'Poner las hojas origen
coOri = Array("D2:D20", "F3:F50", "I") 'Poner rangos o columnas origen
coDes = Array("C", "C", "F") 'Poner las columnas destino
'
For i = LBound(coDes) To UBound(coDes)
h1.Columns(coDes(i)).ClearContents
Next
'
For i = LBound(coDes) To UBound(coDes)
Set h2 = Sheets(hojas(i))
u = h1.Range(coDes(i) & Rows.Count).End(xlUp).Row
If u > 1 Then u = u + 1
If InStr(1, coOri(i), ":") > 0 Then
h2.Range(coOri(i)).Copy h1.Cells(u, coDes(i))
Else
u2 = h2.Range(coOri(i) & Rows.Count).End(xlUp).Row
h2.Range(h2.Cells(1, coOri(i)), h2.Cells(u2, coOri(i))).Copy h1.Cells(u, coDes(i))
End If
Next
MsgBox "terminado"
End Sub
