Saltar al contenido

Copiar y pegar en otro libro

publicado

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

Featured Replies

publicado

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]

publicado
  • Autor

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

publicado
  • Autor

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,

publicado

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]

publicado
  • Autor

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

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.