Copiar datos en dos libros
Publicado por JOSE (1 intervención) el 04/08/2018 15:17:49
Hola amigo soy nuevo por aca, estoy realizando una macro que copia los datos de un formulario y los pega en una hoja llamada ventas del libro donde esta la macro, ahora quiero que al mismo tiempo me guarde esos datos en otro libro llamado Reporte en su primera hoja llamada ventas. anexo macro que tengo ahora.
p.d. los dos libros estan C:\Users\User\Desktop. Gracias por su apoyo.
p.d. los dos libros estan C:\Users\User\Desktop. Gracias por su apoyo.
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
Private Sub ComboBox1_Change()
If ComboBox1 <> "" Then
TextBox1 = Empty TextBox2 = Empty TextBox3 = Empty TextBox4 = Empty TextBox5 = EmptyDim c As Range
With Worksheets("Inventario").Range("B3:B1000000")
Set c = .Find(ComboBox1, , LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Worksheets("inventario").Visible = True
Worksheets("inventario").Select
c.SelectEnd If
End With
TextBox1 = ActiveCell.Offset(0, -1).Value
TextBox2 = ActiveCell.Offset(0, 0).Value
TextBox3 = ActiveCell.Offset(0, 1).Value
TextBox4 = ActiveCell.Offset(0, 2).Value
ComboBox1 = ""
Exit Sub
End If
End Sub
Private Sub CommandButton1_Click()
If TextBox1 <> "" Then
Worksheets("inventario").Visible = True
Worksheets("inventario").Select
If TextBox5 <> "" Then
ActiveCell.Offset(0, 6).Value = ActiveCell.Offset(0, 6).Value + TextBox6
Else
MsgBox "Ingrese Fecha" TextBox7.SetFocusExit Sub
End If
Else
MsgBox "Ingrese Cantidad" TextBox6.SetFocusExit Sub
End If
Worksheets("Ventas").Select
ActiveCell.Offset(0, 0).Value = TextBox1.Value
ActiveCell.Offset(0, 1).Value = TextBox2.Value
ActiveCell.Offset(0, 2).Value = TextBox3.Value
ActiveCell.Offset(0, 3).Value = TextBox4.Value ' Estos son los datos a copiar en el otro libro
ActiveCell.Offset(0, 4).Value = TextBox5.Value
ActiveCell.Offset(0, 5).Value = TextBox6.Value
ActiveCell.Offset(0, 6).Value = TextBox7.Value
Worksheets("Ventas").Select
Cells.Find(What:=TextBox1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Offset(1, 0).Select
TextBox1 = ActiveCellIf TextBox1 = ActiveCell Then TextBox1 = Empty TextBox2 = Empty TextBox3 = Empty TextBox4 = Empty TextBox5 = Empty TextBox6 = Empty TextBox7 = Empty ComboBox1.SetFocusWorksheets("menu").Select
Worksheets("inventario").Visible = True
End If
End Sub
Private Sub CommandButton2_Click()
Worksheets("inventario").Visible = False
Worksheets("menu").Select
Ventas.Caption = "GUARDANDO ESPERE!!!"
ActiveWorkbook.SaveVentas.Caption = "Ventas de Articulos"
Ventas.HideMenu.ShowEnd Sub
Private Sub CommandButton3_Click()
Calendario.ShowEnd Sub
Private Sub Label4_Click()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub TextBox4_Change()
End Sub
Private Sub TextBox6_Change()
End Sub
Private Sub TextBox7_Change()
End Sub
Private Sub UserForm_Activate()
Dim I As Integer
Worksheets("Ventas").Select
Worksheets("Ventas").Range("a3").Select
'Hasta que no encuentre una fila vacía...
Do While Not IsEmpty(ActiveCell)
'Pues eso, hasta que no encuentre una fila
'vacía que baje una fila para abajo
ActiveCell.Offset(1, 0).Select
Loop
ComboBox1.ClearTextBox1 = EmptyTextBox2 = EmptyTextBox3 = EmptyTextBox4 = EmptyTextBox5 = EmptyTextBox6 = EmptyTextBox7 = EmptyComboBox1.SetFocusI = 3Do
ComboBox1.AddItem Worksheets("INVENTARIO").Cells(I, 2).Value
I = I + 1
Loop Until Worksheets("INVENTARIO").Cells(I, 2).Value = ""
End Sub
Valora esta pregunta
0
