Copiar rangos entre 2 libros excel abiertos

Pretendo copiar un rango de datos entre 2 libros contenidos en cierta carpeta, la macro abriría los 2 libros, uno de ellos tendría un nombre fijo "formatoOK.xlsx" y el otro tendría un nombre variable.

He probado este código pero no funciona:

Sub Macro2()
'
Dim Libros As String
Libros = Dir("C:\Usuario\Desktop\Pruebas\*.xls")
Do While Libros <> ""
Workbooks.Open "C:\Usuario\Desktop\Pruebas\" & Libros

'
Windows("formatoNOK.xls").Activate
Range("B7:AB55").Select
Selection.Copy
Windows("formatoOK.xls").Activate
Range("B7:C7").Select
ActiveSheet.Paste
Libros = Dir
Loop

End Sub

2 Respuestas

Respuesta
3

Digamos: que desde un libro con la macro, intentas abrir 2 libros: uno llamado OK y el otro no sabemos.

Las preguntas son:

1- ¿Ya sabemos que solo hay 2 libros en esa carpeta?

2- Se pasa del libro variable al libro OK, ¿verdad?

3- Cómo es eso de copiar rango B:AB y pegarlo solo en rango B:¿C?

Esperaré tus aclaraciones. No valores antes de finalizar el tema.

Hola Elsa,

1- en un principio trabajaríamos con 2 libros en la carpeta, no sé si se puede detectar si hay más de dos libros en esa carpeta y que salga un mensaje al usuario para avisarle que deje 2 libros solamente.

2- Sí

3- Se copia todo el rango (con imágenes incluidas) y se pega a una celda combinada.

Saludos

Ya no se a quien sigues con este tema... pero respondo a tus aclaraciones con macro siguiente.

Sub CopiaRango()
'x Elsamatilde
Application.ScreenUpdating = False
ruta = "C:\Usuario\Desktop\Pruebas"
'controla si existe el libro OK
libOK = "formatoOK.xls"
If Dir(ruta & "\" & libOK) = "" Then
    MsgBox "No existe el libro: " & libOK, vbExclamation
    Exit Sub
End If
'se evalúa la cantidad de libros en la carpeta
Dim canti As Integer
With CreateObject("scripting.filesystemobject")
    With .GetFolder(ruta)
    canti = .Files.Count
    If canti <> 2 Then
        MsgBox "La carpeta contiene menos o más de 2 libros. Verifica y vuelve a ejecutar.", , "ATENCIÓN"
        Exit Sub
    End If
    'se abren los 2 libros
    For Each Archi In .Files
        Workbooks.Open Archi
        'se asigna nombre al libro 'desconocido'
        If ActiveWorkbook.Name <> "formatoOK.xls" Then libNO = ActiveWorkbook.Name
    Next Archi
    End With
End With
'ya están los 2 libros abiertos, se activa el del NO
Workbooks(libNO).Activate
'se copia el rango indicado pegándolo en libro OK
ActiveWorkbook.Sheets(1).Range("B7:AB55").Copy
Workbooks(libOK).Sheets(1).Range("B7").PasteSpecial xlAll
'OPCIONAL: cerrar los libros
Workbooks(libOK).Close True    'se guardan cambios en libro destino
ActiveWorkbook.Close False    'no se guardan cambios en libro origen
'si está todo bien abre los 2 libros de la carpeta
MsgBox "Fin del proceso.", , "INFORMACIÓN"
End Sub

Van las aclaraciones en la misma macro, cualquier duda comenta.

Hola Elsa,

disculpa va perfecto pero si en vez de que se abran los archivos de la carpeta al final de la macro quisiera que se quedarán cerrados ¿cómo sería?

Hola , si quisiera que los 2 archivos no se abriesen al final de la macro ¿cómo sería?

Al final como opción, los archivos se CIERRAN:

'OPCIONAL: cerrar los libros
Workbooks(libOK).Close True    'se guardan cambios en libro destino
ActiveWorkbook. Close False 'no se guardan cambios en libro origen

El comentario que aparecía a continuación era solo eso ... un comentario (x error) que se puede borrar... no hay más instrucciones por lo tanto los libros no se están abriendo.

Sdos!

Respuesta
5

Te anexo la macro para abrir los 2 libros, copiar el rango "B7:AB55", del libro1 "formatoNOK" al libro2 "formatoOK", guarda el libro2 y cierra los 2 libros.

Pon la macro en un libro nuevo.

Los 2 libros deben estar en la misma carpeta: "C:\Usuario\Desktop\Pruebas\"



Sub CopiaRango()
'Por.Dante Amor
    Application.ScreenUpdating = False
    ruta = "C:\Usuario\Desktop\Pruebas\"
    'ruta = ThisWorkbook.Path & "\"
    lib1 = "formatoNOK.xls"
    lib2 = "formatoOK.xls"
    If Dir(ruta & lib1) = "" Then
        MsgBox "No existe el libro: " & lib1, vbExclamation
        Exit Sub
    End If
    If Dir(ruta & lib2) = "" Then
        MsgBox "No existe el libro: " & lib2, vbExclamation
        Exit Sub
    End If
    Set l1 = Workbooks.Open(ruta & lib1)
    Set l2 = Workbooks.Open(ruta & lib2)
    l1.Sheets(1).Range("B7:AB55").Copy
    l2.Sheets(1).Range("B7").PasteSpecial xlAll
    l2.Save
    l1.Close
    l2.Close
    MsgBox "Rango Copiado", vbInformation
End Sub

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Hola Dante, lo que pasa es que el libro "formatoNOK" tendría un nombre variable, libro1, libro2, libro34, etc,,,,

¿Pero cómo saber cuál es el nombre?

¿Piensas poner el nombre en alguna celda?

¿O en la carpeta solamente existirán 2 libros? En ese caso la macro abrirá los 2 libros sin importar como se llamen.

Tienes que decirme de qué forma se puede saber cuál es el nombre.

El nombre del arvhivo "formatoNOK" se puede extraer de la celda AS15 del libro "formatoNOK", es una celda con la fórmula de texto "extrae".

¿Hay alguna manera que salte un msgbox si hay más de 2 libros en esa carpeta?

Celda AS15 en la hoja "edicion"

Pusiste este comentario:

"

El nombre del arvhivo "formatoNOK" se puede extraer de la celda AS15 del libro "formatoNOK", es una celda con la fórmula de texto "extrae".

"

Pero tengo que entrar al archivo "formatoNOK", para ver que en la celda está el mismo nombre "formatoNOK"; pero antes de entrar al libro tengo que saber cómo se llama el libro.

Si no hay una regla clara para identificar el nombre del archivo, entonces simplemente entra a la macro, cambia el nombre del libro en esta línea:

    lib1 = "formatoNOK.xls"

Y ejecuta la macro.


' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas