Copiar datos de un libro excel a otro

No encontré nada extraño en la macro.

Solo agregue la función IsFileOpen()

Pero supongo tu ya la tienes.

En este link lo puedes ver funcionando correctamente

http://1drv.ms/1G4TSZI 

Si tienes alguna pregunta no dudes en hacerla.

No se te olvide dar por finalizada la pregunta

Hola Víctor, revisé el link que me enviaste pero igual no traslada la información que uno deposita en el userform al otro libro de excel. No me funciona. ¿Habrá otra forma de poder copiar los datos?

¿La macro no funciona? O no hace lo que tu necesitas.

El error 9 (subíndice fuera del intervalo), puede provocarse por varias razones, una de ellas es que el archivo destino este lleno.

¿En qué línea se produce el error?

Nuevamente gracias por responder...Ok, te explico...Al usar el userform del archivo origen (gestor de inventario) me carga la información en ese libro; simultáneamente quisiera que esos mismos datos los trasladara al libro destino (costos.xlsx); sin embargo, me lo carga al primero pero se cuelga y no envía los datos al libro destino. Te voy a enviar la línea donde aparece el error y también la macro completa:

error ---> If .Worksheets("Hoja1").Cells(Fila, 1) = "" Then

no sé si debo especificar el nombre del archivo destino

La macro completa es así:

Private Sub CommandButton1_Click()
Dim Registro As Integer
Dim Titulo As String
Dim objExcel As Application
Dim RutaArchivo As String
Dim Texto As String
Dim Fila As Integer
Dim Final As Integer
Titulo = "Gestor de Inventarios"
'Validando los controles sin datos
If Me.txt_CodProd = "" Then
Me.txt_CodProd.BackColor = &HC0C0FF
MsgBox "Debe ingresar un Código", , Titulo
Me.txt_CodProd.SetFocus
Exit Sub
ElseIf Me.txt_Nombre = "" Then
Me.txt_Nombre.BackColor = &HC0C0FF
MsgBox "Debe ingresar un Nombre de Producto", , Titulo
Me.txt_Nombre.SetFocus
Exit Sub
ElseIf Me.txt_Descrip = "" Then
Me.txt_Descrip.BackColor = &HC0C0FF
MsgBox "Debe ingresar una Descripción", , Titulo
Me.txt_Descrip.SetFocus
Exit Sub
ElseIf Me.txt_Marca = "" Then
Me.txt_Descrip.BackColor = &HC0C0FF
MsgBox "Debe ingresar una Marca", , Titulo
Me.txt_Marca.SetFocus
Exit Sub
ElseIf Me.Txt_PrecioP = 0 Then
Me.Txt_PrecioP.BackColor = &HC0C0FF
MsgBox "Debe ingresar el Precio de Producto", , Titulo
Me.Txt_PrecioP.SetFocus
Exit Sub
ElseIf Me.Txt_CostoU = 0 Then
Me.Txt_CostoU.BackColor = &HC0C0FF
MsgBox "Debe ingresar el Costo Unitario", , Titulo
Me.Txt_CostoU.SetFocus
Exit Sub
End If
'Determina el final del listado de productos
For Fila = 1 To 5000
If Hoja2.Cells(Fila, 1) = "" Then
Final = Fila
Exit For
End If
Next
'Validación para impedir registros repetidos
For Registro = 2 To Final
If Hoja2.Cells(Registro, 1) = Val(Me.txt_CodProd) Then
Me.txt_CodProd.BackColor = &H8080FF
MsgBox ("Registro ya existe" + Chr(13) + "Ingrese un código diferente")
Me.txt_CodProd.SetFocus
Exit Sub
Exit For
End If
Next
If MsgBox("Son correctos los datos?" + Chr(13) + "Desea proceder?", vbOKCancel) = vbOK Then
'Envía los datos a la hoja de productos
Me.txt_CodProd.BackColor = &HFFFFFF
Hoja2.Cells(Final, 1) = Val(Me.txt_CodProd)
Hoja2.Cells(Final, 2) = Me.txt_Nombre
Hoja2.Cells(Final, 3) = Me.txt_Descrip
Hoja2.Cells(Final, 4) = Me.txt_Marca
Hoja2.Cells(Final, 5) = Me.Txt_PrecioP.Text
Hoja2.Cells(Final, 5).NumberFormat = "#,##0.00"
Hoja2.Cells(Final, 6) = Me.Txt_CostoU.Text
Hoja2.Cells(Final, 6).NumberFormat = "#,##0.00"
Hoja2.Cells(Final, 7) = Hoja8.Range("G1") 'Usuario responsalbe de la operación
'-----------------------------------------------
'Envía los datos a la hoja de existencias
Hoja5.Cells(Final, 1) = Val(Me.txt_CodProd)
Hoja5.Cells(Final, 2) = Me.txt_Nombre
Hoja5.Cells(Final, 3) = 0
Hoja5.Cells(Final, 4) = Me.Txt_PrecioP.Text
Hoja5.Cells(Final, 4).NumberFormat = "#,##0.00"
Hoja5.Cells(Final, 5) = Me.Txt_CostoU.Text
Hoja5.Cells(Final, 5).NumberFormat = "#,##0.00"
'-----------------------------------------------
'Limpia los controles
Me.txt_CodProd = ""
Me.txt_Nombre = ""
Me.txt_Descrip = ""
Me.txt_Marca = ""
Me.Txt_PrecioP = ""
Me.Txt_CostoU = ""
Me.txt_CodProd.SetFocus
Else
Exit Sub
End If

Texto = "Espere un momento... Procesando la información"
Application.StatusBar = Texto

Set objExcel = CreateObject("Excel.Application")

With objExcel

RutaArchivo = ThisWorkbook.Path & "\COSTOS.xlsx"

If IsFileOpen(RutaArchivo) Then
MsgBox "El libro debe estar cerrado para proceder."
Exit Sub
Else
'
With .Workbooks.Open(RutaArchivo)
For Fila = 2 To 5000
If .Worksheets("Hoja1").Cells(Fila, 1) = "" Then
Final = Fila
Exit For
End If
Next
.Worksheets("Hoja1").Cells(Final, 1) = Me.txt_CodProd
.Worksheets("Hoja1").Cells(Final, 2) = Me.txt_Nombre
.Worksheets("Hoja1").Cells(Final, 3) = Me.txt_Descrip
.Worksheets("Hoja1").Cells(Final, 4) = Me.txt_Marca
.Worksheets("Hoja1").Cells(Final, 5) = Me.Txt_PrecioP
.Worksheets("Hoja1").Cells(Final, 6) = Me.Txt_CostoU
.Close SaveChanges:=True
End With
End If
'
.Quit
End With

Call LiberarBarra
MsgBox "Información procesada con éxito!"
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub txt_CodProd_Change()
Me.txt_CodProd.BackColor = &HFFFFFF
End Sub

Private Sub txt_CostoU_Change()
Me.Txt_PrecioP.BackColor = &HFFFFFF
End Sub

Private Sub txt_PrecioP_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.Txt_PrecioP.Text = Format(Me.Txt_PrecioP.Text, "#,##0.00")
End Sub

Private Sub txt_Descrip_Change()
Me.txt_Descrip.BackColor = &HFFFFFF
End Sub

Private Sub txt_Nombre_Change()
Me.txt_Nombre.BackColor = &HFFFFFF
End Sub

Private Sub txt_CostoUnitario_Change()
Me.Txt_CostoU.BackColor = &HFFFFFF
End Sub

Private Sub txt_CostoU_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.Txt_CostoU.Text = Format(Me.Txt_CostoU.Text, "#,##0.00")
End Sub

La macro funciona correctamente, el problema es que estabas borrando el contenido de los textbox y luego lo enviabas a costos, por ende no enviabas nada.

Modifique el orden de u código, y parece que ya funciona. Saludos!

Private Sub CommandButton1_Click()
Dim Registro As Integer
Dim Titulo As String
Dim objExcel As Application
Dim RutaArchivo As String
Dim Texto As String
Dim Fila As Integer
Dim Final As Integer
Titulo = "Gestor de Inventarios"
'Validando los controles sin datos
If Me.txt_CodProd = "" Then
Me.txt_CodProd.BackColor = &HC0C0FF
MsgBox "Debe ingresar un Código", , Titulo
Me.txt_CodProd.SetFocus
Exit Sub
ElseIf Me.txt_Nombre = "" Then
Me.txt_Nombre.BackColor = &HC0C0FF
MsgBox "Debe ingresar un Nombre de Producto", , Titulo
Me.txt_Nombre.SetFocus
Exit Sub
ElseIf Me.txt_Descrip = "" Then
Me.txt_Descrip.BackColor = &HC0C0FF
MsgBox "Debe ingresar una Descripción", , Titulo
Me.txt_Descrip.SetFocus
Exit Sub
ElseIf Me.txt_Marca = "" Then
Me.txt_Descrip.BackColor = &HC0C0FF
MsgBox "Debe ingresar una Marca", , Titulo
Me.txt_Marca.SetFocus
Exit Sub
ElseIf Me.Txt_PrecioP = 0 Then
Me.Txt_PrecioP.BackColor = &HC0C0FF
MsgBox "Debe ingresar el Precio de Producto", , Titulo
Me.Txt_PrecioP.SetFocus
Exit Sub
ElseIf Me.Txt_CostoU = 0 Then
Me.Txt_CostoU.BackColor = &HC0C0FF
MsgBox "Debe ingresar el Costo Unitario", , Titulo
Me.Txt_CostoU.SetFocus
Exit Sub
End If
'Determina el final del listado de productos
For Fila = 1 To 5000
If Hoja2.Cells(Fila, 1) = "" Then
Final = Fila
Exit For
End If
Next
'Validación para impedir registros repetidos
For Registro = 2 To Final
If Hoja2.Cells(Registro, 1) = Val(Me.txt_CodProd) Then
Me.txt_CodProd.BackColor = &H8080FF
MsgBox ("Registro ya existe" + Chr(13) + "Ingrese un código diferente")
Me.txt_CodProd.SetFocus
Exit Sub
Exit For
End If
Next
If MsgBox("Son correctos los datos?" + Chr(13) + "Desea proceder?", vbOKCancel) = vbOK Then
'Envía los datos a la hoja de productos
Me.txt_CodProd.BackColor = &HFFFFFF
Hoja2.Cells(Final, 1) = Val(Me.txt_CodProd)
Hoja2.Cells(Final, 2) = Me.txt_Nombre
Hoja2.Cells(Final, 3) = Me.txt_Descrip
Hoja2.Cells(Final, 4) = Me.txt_Marca
Hoja2.Cells(Final, 5) = Me.Txt_PrecioP.Text
Hoja2.Cells(Final, 5).NumberFormat = "#,##0.00"
Hoja2.Cells(Final, 6) = Me.Txt_CostoU.Text
Hoja2.Cells(Final, 6).NumberFormat = "#,##0.00"
Hoja2.Cells(Final, 7) = Hoja8.Range("G1") 'Usuario responsalbe de la operación
'-----------------------------------------------
'Envía los datos a la hoja de existencias
Hoja5.Cells(Final, 1) = Val(Me.txt_CodProd)
Hoja5.Cells(Final, 2) = Me.txt_Nombre
Hoja5.Cells(Final, 3) = 0
Hoja5.Cells(Final, 4) = Me.Txt_PrecioP.Text
Hoja5.Cells(Final, 4).NumberFormat = "#,##0.00"
Hoja5.Cells(Final, 5) = Me.Txt_CostoU.Text
Hoja5.Cells(Final, 5).NumberFormat = "#,##0.00"
'-----------------------------------------------

Texto = "Espere un momento... Procesando la información"
Application.StatusBar = Texto

Set objExcel = CreateObject("Excel.Application")

With objExcel

RutaArchivo = ThisWorkbook.Path & "\COSTOS.xlsx"

If IsFileOpen(RutaArchivo) Then
MsgBox "El libro debe estar cerrado para proceder."
Exit Sub
Else
'
With .Workbooks.Open(RutaArchivo)
For Fila = 2 To 5000
If .Worksheets("Hoja1").Cells(Fila, 1) = "" Then
Final = Fila
Exit For
End If
Next
.Worksheets("Hoja1").Cells(Final, 1) = Me.txt_CodProd
.Worksheets("Hoja1").Cells(Final, 2) = Me.txt_Nombre
.Worksheets("Hoja1").Cells(Final, 3) = Me.txt_Descrip
.Worksheets("Hoja1").Cells(Final, 4) = Me.txt_Marca
.Worksheets("Hoja1").Cells(Final, 5) = Me.Txt_PrecioP
.Worksheets("Hoja1").Cells(Final, 6) = Me.Txt_CostoU
.Close SaveChanges:=True
End With
End If
'
.Quit
End With

'Limpia los controles
Me.txt_CodProd = ""
Me.txt_Nombre = ""
Me.txt_Descrip = ""
Me.txt_Marca = ""
Me.Txt_PrecioP = ""
Me.Txt_CostoU = ""
Me.txt_CodProd.SetFocus

Call LiberarBarra
MsgBox "Información procesada con éxito!"

Else
Exit Sub
End If

End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub txt_CodProd_Change()
Me.txt_CodProd.BackColor = &HFFFFFF
End Sub

Private Sub txt_CostoU_Change()
Me.Txt_PrecioP.BackColor = &HFFFFFF
End Sub

Private Sub txt_PrecioP_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.Txt_PrecioP.Text = Format(Me.Txt_PrecioP.Text, "#,##0.00")
End Sub

Private Sub txt_Descrip_Change()
Me.txt_Descrip.BackColor = &HFFFFFF
End Sub

Private Sub txt_Nombre_Change()
Me.txt_Nombre.BackColor = &HFFFFFF
End Sub

Private Sub txt_CostoUnitario_Change()
Me.Txt_CostoU.BackColor = &HFFFFFF
End Sub

Private Sub txt_CostoU_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.Txt_CostoU.Text = Format(Me.Txt_CostoU.Text, "#,##0.00")

End Sub