Hola amigos, me pueden ayudar a solucionar este asunto, quiero copiar rangos no adyacentes de un libro a otro es decir el resumen de importes y servicios a un nuevo libro estuve buscando, pero encontré nada, anexo los archivas para la posible solución

el archivo origen se llama comparativo y el archivo destino se llama resumen

Saludos cordiales

Comparativo.rar

Abre los dos archivos en la misma instancia Excel y ejecuta la macro adjunta desde Comparativo.xlsm, la macro copia las filas amarillas al archivo Resumen.xlsx.

Sub ActualizarResumen()

Dim Resumen


Set Resumen = Workbooks("Resumen.xlsx").Sheets("Hoja1")

Range("A:O").Copy Resumen.Range("A1")

Resumen.UsedRange = Resumen.UsedRange.Value

For x = Resumen.Range("B1").End(xlDown).Row To 2 Step -1

   If Not Resumen.Range("B" & x).Interior.Color = vbYellow Then

      Resumen.Rows(x).Delete

   End If

Next


End Sub

[/CODE]

[/b]

Hola buen día, Macro Antonio, con el gusto de saludarte y agradecerte el apoyo, pero me sale un error que la variable no esta definida, y un favor mas si quiero adicionar otros rangos, anexo el archivo,

Comparativo.rar

Nuevamente a mi a migo [uSER=46507]@Macro Antonio[/uSER]. Ya corregi lo de la Variable, pero otra consulta si solo quiero algunos meses por decir solo los meses de enero, abril, mayo, junio,

Abre los dos archivos en la misma instancia Excel y ejecuta la macro adjunta desde Comparativo.xlsm, la macro copia las filas con la columna B amarilla al archivo Resumen.xlsx desde Enero hasta el mes que informes al ejecutar la macro.

Option Base 1

Sub ActualizarResumen()

Dim Resumen, Letras, Total, Mes


Application.ScreenUpdating = False

Letras = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "K", "M", "N")


Do Until IsNumeric(Mes) = True And Mes > 0 And Mes < 12

   Mes = InputBox("Introducir el mes HASTA del resumen." & Chr(10) & _

                "Ejemplo: 1=Enero, 2=Febrero,....12=Diciembre")

Loop


Columns("A:" & Letras(CInt(Mes) + 2)).Select

Set Resumen = Workbooks("Resumen.xlsx").Sheets("Hoja1")

Resumen.Cells.Clear

Selection.Copy Resumen.Range("A1")

Total = Letras(Selection.Columns.Count + 1)

Hasta = Letras(Selection.Columns.Count)

Columns("O:O").Copy Resumen.Columns(Selection.Columns.Count + 1)

Resumen.UsedRange = Resumen.UsedRange.Value


For x = Resumen.Range("B1").End(xlDown).Row To 2 Step -1

   If Not Resumen.Range("B" & x).Interior.Color = vbYellow Then

      Resumen.Rows(x).Delete

   End If

Next


For x = 2 To Resumen.Range("B1").End(xlDown).Row

   Resumen.Range(Total & x).Formula = "=SUM(C" & x & ":" & Hasta & x & ")"

Next

Range("A1").Select

Workbooks("Resumen.xlsx").Activate

End Sub

[/CODE]

Genial, [uSER=46507]@Macro Antonio[/uSER]. Otra ultima consulta, si también quisiera los servicios que estan en las columnas de la Q:AC ,los cuales son los servicios y de AE:AQ, los cuales son los promedio, te agradezco mucho tu ayuda