Copiar datos de un libro excel a otro
Publicado por Yely (1 intervención) el 18/06/2015 18:45:27
Hola!! Mi caso es el siguiente: En un libro excel ingreso datos en un userform del archivo origen (gestor de inventario), me carga la información en ese libro y simultáneamente quisiera que esos mismos datos los trasladara al libro destino (costos.xlsx). Sin embargo me aparece un error ('9' o '438') que no permite se concluya la operación y lo que sucede es que NO traslada los datos al otro libro. Les copio aquí la macro completa a ver si me pueden ayudar a resolver el problema. Lo resaltado en negritas es donde está la programación para enviar los datos al libro destino. De antemano un millón de gracias!
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
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 5000If Hoja2.Cells(Fila, 1) = "" Then
Final = FilaExit For
End If
Next
'Validación para impedir registros repetidos
For Registro = 2 To FinalIf 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 5000If .Worksheets("Hoja1").Cells(Fila, 1) = "" Then
Final = FilaExit 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
'
.QuitEnd 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
Valora esta pregunta
0