Copiar y pegar en otro libro

[abrahampadron]

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

[Antoni]

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]

[abrahampadron]

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

[abrahampadron]

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,

[Antoni]

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]

[abrahampadron]

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