Macro de Excel (libro A) que seleccione un archivo de excel (libro B), verifique si es el correcto y copie una hoja de B en A
Uso un sistema que saca reportes en formato XLS. Tengo un libro de Excel en donde pego la hoja de ese reporte y en otra hoja me ordena todos los datos. Quiero hacer ese Abrir archivo, ver que es el correcto, copiar la hoja completa y pegarla en el otro como sólo valores de forma automática.
Los problemas son:
1) Que todos los archivos de reporte se llaman igual "reporte(<el consecutivo de guardado>).xls". Lo que los diferencía, es el título interno en la celda G2. El cual, para ser bueno, debe decir "Reporte Inventario".
Así que al usar la macro para abrir el archivo, la macro debe checar que es el correcto antes de copiar la página.
2) Copiar la única página del libro (llamada Reporte) y pegar sólo los valores en la página de libro con la macro (la página se llama A SUBIR).
1 respuesta
Te paso el código. Fíjate las anotaciones que te puse.
Sub abrir()
Rec = ActiveWorkbook.Name
Application.ScreenUpdating = False
'en caso de que el archivo no sea correcto, volvera a correr desde aqui la macro
ingresodenuevo:
MsgBox "Seleccione archivo"
Dim arch$, myCell As Range, Rng As Range
'genera la hoja donde se van a pegar los datos
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "A SUBIR"
Intersect([a1].CurrentRegion, [a:ad]).Offset(1).Delete xlShiftUp
Set myCell = [a1]
'pide el archivo
arch = _
Application.GetOpenFilename("Libro de Microsoft Excel (*.xls), *.xls")
' en caso de que el usuario cancele la importacion va saltar hasta la etiqueta "falloimportar"
On Error GoTo falloimportar
' con el archivo abierto, selecciona la hoja completa y la pega en el archivo de la macro. luego cierra el archivo
With Workbooks.Open(arch, 0, True).Sheets(1)
Rdat = ActiveWorkbook.Name
Cells.Select
Selection.Copy
Windows(Rec).Activate
Cells.Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Windows(Rdat).Close
End With
'verifica si la celda "G2" tiene una palabra distitna a "Reporte inventario"
If Range("g2") <> "Reporte Inventario" Then
' si es afirmativo, elimina la solapa "A SUBIR" y vuelve al prrincicio
Application.DisplayAlerts = False
Sheets("A SUBIR").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
GoTo ingresodenuevo
End If
' En caso que sea negativo el condicional, o sea, G2 = "Reporte inventario"
' Acá pones como sigue tu código, sino puedes detener aquí la macro, por ejemplo como esta aquí
Exit Sub
'en caso que el usuario cancelo el ingreso del archivo, elimina la solapa y finaliza todo el proceso.
Falloimportar:
Application.DisplayAlerts = False
Sheets("A SUBIR").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
End Sub
Valora si te fue útil.
