Copiar diferentes rangos con macro
Tengo una macro que copia un rango de un documento a otro, pero no se como hacer para que copie diferentes rangos de un libro a otro, por ejemplo que copie el rango "O42:O62", el rango "O70:O80 y el rango "O88:O104". Actualmente copia todo el rango "O42:O104"
Pongo la macro.
Gracias
Saludos
Oscar
'Copiar informacion de Reporte a Bitacora Sub Copiar_adjuntos() Application.ScreenUpdating = False Set l1 = ThisWorkbook Ruta = "C:\Users\z003bpca\Desktop\Bitacora\" arch = "copy_Reporte.xls" If Dir(Ruta & arch) = "" Then MsgBox "El archivo Reporte no existe en la ruta", vbCritical Exit Sub End If ' Set l2 = Workbooks.Open(Ruta & arch) Set h2 = l2.Sheets("Sheet0") Num = h2.Range("D5").Text If Num = "" Then MsgBox "La celda D5 no contiene datos", vbExclamation l2.Close False Exit Sub End If If IsNumeric(Num) Then Num = "" & Val(Num) End If ' existe = False For Each h In l1.Sheets If h.Name = Num Then existe = True Set h1 = h Exit For End If Next ' If existe = False Then l1.Sheets.Add after:=l1.Sheets(l1.Sheets.Count) Set h1 = l1.ActiveSheet 'copia de columna A de Hoja Datos Sheets("Datos").Visible = True Sheets("Datos").Columns("A").Copy h1.Columns("A") 'Sheets("Datos").Visible = False h1.Name = Num End If ' 'uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1 'If uc < Columns("B").Column Then uc = Columns("B").Column 'h2.Range("O42:O104").Copy h1.Cells(1, uc) h1.Columns("B").Insert h2.Range("O42:O104").Copy h1.Cells(8, "B") 'ajusta columnas de B en adelante a 30 h1.Columns.ColumnWidth = 30 h1.Columns("A:A").EntireColumn.AutoFit l2.Close False l1.Save Application.ScreenUpdating = True 'MsgBox "Copia realizada", vbInformation End Sub
Respuesta de Dante Amor
1