Macro que abra un libro de Excel y copie su información en otro.
Espero me puedan ayudar con este detalle, al momento de generar una macro.
Tengo un libro templete habilitado para macros donde necesito copiar información de otro libro de Excel que se va generando de una pagina de intranet. En el libro templete la información se debe pegar en la fila 4 y va desde la columna A hasta la F.
En el libro donde se encuentra la información, la hoja se llama " owssvr " normalmente siempre se llamara así, el archivo tiene un encabezado en la fila 1 y la información comienza en la fila 2. Igual de la columna A hasta la F.
Tengo esta macro:
Sub openbook()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim myfile, mybook, a, b, c As String
On Error Resume Next
Ruta = ActiveWorkbook.Path
ChDir Ruta
myfile = Application.GetOpenFilename("archivos Excel (*.xl*),*.xl*")
mybook = ActiveWorkbook.Name
b = "owssvr"
c = "Sheet1"
Workbooks.Open Filename:=myfile, UpdateLinks:=0
FullName = Split(myfile, Application.PathSeparator)
a = FullName(UBound(FullName))
Sheets(b).Cells.Copy Destination:=Workbooks(mybook).Sheets(c).Cells(4, 1)
Application.CutCopyMode = False
Workbooks(a).Close False
Application.ScreenUpdating = True
MsgBox ("Los datos se copiaron con éxito"), vbInformation, "AVISO"
End Sub
Al momento de correr la macro, si abre la ventana de explorador de windows para seleccionar el archivo donde esta la información, pero al momento de seleccionarlo y querer pegarla en el templete, no lo hace, solo me dice que " los datos se copiaron con éxito" pero no muestra la información.
Que podre tener mal en la macro, que no me copia la información.
2 Respuestas
En tu macro tienes esta instrucción:
On Error Resume Next
Lo que hace es ignorar cualquier error de la macro y continuar con la siguiente instrucción.
En tu macro tienes esto:
Sheets(b). Cells.Copy Destination:=Workbooks(mybook). Sheets(c). Cells(4, 1)
Lo que estás tratando de hacer es copiar todas las celdas, pero el destino empieza en la fila 4, el error sería:
Se ha producido el error "1004" en tiempo de ejecución.
Para pegar todas las celdas desde una hoja de cálculo, debe pegar en la primea celda (A1)
Pero como tienes la instrucción On Error Resume Next, no te das cuenta del error.
Lo recomendable es que no utilices la instrucción On Error Resume Next y controles con código los posibles errores.
Si lo que quieres es copiar todas las celdas, entonces la propuesta de Cristian es correcta:
Sheets(b). Cells.Copy Destination:=Workbooks(mybook). Sheets(c). Cells(1, 1)
Pero si quisieras copiar solamente la información con datos, podría ser así:
Sub openbook()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim myfile, mybook, a, b, c As String
Ruta = ActiveWorkbook.Path
ChDir Ruta
myfile = Application.GetOpenFilename("archivos Excel (*.xl*),*.xl*")
mybook = ActiveWorkbook.Name
b = "owssvr"
c = "Sheet1"
Workbooks.Open Filename:=myfile, UpdateLinks:=0
FullName = Split(myfile, Application.PathSeparator)
a = FullName(UBound(FullName))
'
'obtiene la última fila con datos
u = Sheets(b).UsedRange.Rows(Sheets(b).UsedRange.Rows.Count).Row
Sheets(b).Rows("1:" & u).Copy Destination:=Workbooks(mybook).Sheets(c).Cells(4, 1)
'
Application.CutCopyMode = False
Workbooks(a).Close False
Application.ScreenUpdating = True
MsgBox ("Los datos se copiaron con éxito"), vbInformation, "AVISO"
End Sub[Si te ayudó la información, no olvides valorar la respuesta.