将特定数据复制到另一个closures的工作簿

我是Excel VBA的新手。

请看附件文件。

我在将具体数据保存到另一个封闭的工作簿时遇到了麻烦。 因为每次我复制数据并将其保存到目标工作簿的特定工作表时，它将覆盖现有数据。

我想要的是不断添加数据，每次我从列表框中复制一个过滤的数据，并将其发送到目标工作簿。

老实说，我只下载这个文件，我想用这个作为我们的logging

Dim a, i As Byte, deg As String Private Sub CommandButton1_Click() Dim sonsat, lastrow As Long, ara As Range If TextBox1.Text = "" Or TextBox3.Text = "" Then MsgBox "Incomplete Data", vbCritical, "" TextBox1.SetFocus Exit Sub End If lastrow = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row sonsat = Sheets("liste").Cells(Rows.Count, "A").End(xlUp).Row + 1 Set ara = Range("B2:B" & lastrow).Find(What:=TextBox1.Text, LookIn:=xlValues, LookAt:=xlWhole) If Not ara Is Nothing Then MsgBox "This name already exist ! Please try a different name", vbCritical, "" TextBox1.SetFocus Exit Sub End If Cells(sonsat, 1) = sonsat - 1 Cells(sonsat, 2) = TextBox1 Cells(sonsat, 3) = TextBox2 Cells(sonsat, 4) = TextBox3 Cells(sonsat, 5) = TextBox4 Cells(sonsat, 6) = TextBox5 Cells(sonsat, 7) = TextBox6 Cells(sonsat, 8) = TextBox7 Cells(sonsat, 9) = TextBox8 Cells(sonsat, 10) = TextBox11 Cells(sonsat, 11) = TextBox12 Cells(sonsat, 12) = TextBox13 Cells(sonsat, 13) = TextBox14 Range("A" & sonsat & ":M" & sonsat).Font.ColorIndex = 11 MsgBox "Registration is successful", vbInformation, "" Range("A" & sonsat & ":M" & sonsat).Interior.ColorIndex = 25 Call sort_id Call text_boxes_clear End Sub Private Sub CommandButton10_Click() If ListBox1.ListCount = 0 Then MsgBox "No items that will be copied.", vbCritical, "" Exit Sub End If Call add_sheets If ComboBox1.Value = "" Then MsgBox "Please Choose A WorkSheet From Drop-Down List ", vbInformation, "" ComboBox1.SetFocus Exit Sub End If Workbooks.Open (ThisWorkbook.Path & "\Database.xls") Sheets(ComboBox1.Value).UsedRange.Cells.Clear Sheets(ComboBox1.Value).Range("A2:L" & ListBox1.ListCount + 1) = ListBox1.List Sheets(ComboBox1.Value).Columns.AutoFit ActiveWorkbook.Close True MsgBox "The Listbox Records Were Copied.", vbInformation, "" ComboBox1.Clear ComboBox1.Enabled = False Application.ScreenUpdating = True End Sub Private Sub CommandButton2_Click() Dim sonsat, lastrow As Long, sor As String If TextBox1.Text = "" Or TextBox3.Text = "" Then MsgBox "Item Is Not Selected To Change", vbCritical, "" Exit Sub End If sor = MsgBox("Are your sure?", vbYesNo, "") If sor = vbNo Then Exit Sub lastrow = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row Sheets("liste").Range("B2:B" & lastrow).Find(What:=ListBox1.Text, LookIn:=xlValues, LookAt:=xlWhole).Activate sonsat = ActiveCell.Row Cells(sonsat, 2) = TextBox1 Cells(sonsat, 3) = TextBox2 Cells(sonsat, 4) = TextBox3 Cells(sonsat, 5) = TextBox4 Cells(sonsat, 6) = TextBox5 Cells(sonsat, 7) = TextBox6 Cells(sonsat, 8) = TextBox7 Cells(sonsat, 9) = TextBox8 Cells(sonsat, 10) = TextBox11 Cells(sonsat, 11) = TextBox12 Cells(sonsat, 12) = TextBox13 Cells(sonsat, 13) = TextBox14 Range("A" & sonsat & ":M" & sonsat).Font.ColorIndex = 11 MsgBox "Item Has Been Changed", vbInformation, "" Call listbox_refresh Call text_boxes_clear ListBox1.Clear CommandButton3.Enabled = False CommandButton2.Enabled = False CommandButton1.Enabled = True End Sub Private Sub CommandButton3_Click() Dim cevap As String If ListBox1.ListIndex >= 0 Then cevap = MsgBox("Entry will be deleted. ... Are you sure ?", vbYesNo, "") If cevap = vbYes Then lastrow = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row Sheets("liste").Range("B2:B" & lastrow).Find(What:=ListBox1.Text, LookIn:=xlValues, LookAt:=xlWhole).Activate Sheets("liste").Rows(ActiveCell.Row).Delete End If Else MsgBox "Item Is Not Selected To Remove", vbCritical, "" Exit Sub End If ListBox1.Clear Call text_boxes_clear Call sort_id CommandButton2.Enabled = False CommandButton3.Enabled = False CommandButton1.Enabled = True End Sub Private Sub CommandButton5_Click() For a = 1 To 14 Controls("textbox" & a) = "" Next ListBox1.Clear CommandButton1.Enabled = True CommandButton2.Enabled = False CommandButton3.Enabled = False ComboBox1.Clear ComboBox1.Enabled = False End Sub Private Sub CommandButton6_Click() For a = 1 To 14 Controls("textbox" & a) = "" Next Call CommandButton5_Click UserForm2.Hide End Sub Private Sub CommandButton7_Click() Dim sat As Long sat = Cells(Rows.Count, "A").End(xlUp).Row ListBox1.List = Sheets("liste").Range("B2:M" & sat).Value With ListBox1 For i = 1 To 12 deg = deg & CLng(Columns(i + 1).Width) & ";" Next i .ColumnWidths = deg End With ListBox1.ColumnCount = 12 TextBox10.Value = ListBox1.ListCount End Sub Private Sub CommandButton8_Click() ListBox1.Clear Call text_boxes_clear CommandButton1.Enabled = True End Sub Private Sub ListBox1_Click() Dim say, lastrow As Long TextBox1 = ListBox1.Column(0) TextBox2 = ListBox1.Column(1) TextBox3 = ListBox1.Column(2) TextBox4 = ListBox1.Column(3) TextBox5 = ListBox1.Column(4) TextBox6 = ListBox1.Column(5) TextBox7 = ListBox1.Column(6) TextBox8 = ListBox1.Column(7) TextBox11 = ListBox1.Column(8) TextBox12 = ListBox1.Column(9) TextBox13 = ListBox1.Column(10) TextBox14 = ListBox1.Column(11) lastrow = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row Sheets("liste").Range("B2:B" & lastrow).Find(What:=ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate say = ActiveCell.Row Sheets("liste").Range("A" & say & ":M" & say).Select CommandButton1.Enabled = False CommandButton2.Enabled = True CommandButton3.Enabled = True End Sub Private Sub SpinButton1_SpinDown() On Error Resume Next If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub With Me.ListBox1 .ListIndex = .ListIndex + 1 End With End Sub Private Sub SpinButton1_SpinUp() On Error Resume Next If ListBox1.ListIndex = 0 Then Exit Sub With Me.ListBox1 .ListIndex = .ListIndex - 1 End With End Sub Private Sub TextBox9_Change() Dim k As Range, adrs As String, j As Byte, m As Long, myarr() As String Application.ScreenUpdating = False 'CommandButton1.Enabled = False ReDim myarr(1 To 12, 1 To 1) With Worksheets("liste") ListBox1.Clear ListBox1.ColumnCount = 12 If .FilterMode Then .ShowAllData If OptionButton1.Value = True Then Set k = .Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Find(What:=TextBox9.Text & "*", LookIn:=xlValues, LookAt:=xlWhole) Else Set k = .Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Find(What:="*" & TextBox9.Text & "*", LookIn:=xlValues, LookAt:=xlWhole) End If If Not k Is Nothing Then adrs = k.Address Do m = m + 1 ReDim Preserve myarr(1 To 12, 1 To m) For j = 1 To 12 myarr(j, m) = .Cells(k.Row, j + 1).Value Next j Set k = .Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).FindNext(k) Loop While Not k Is Nothing And k.Address <> adrs ListBox1.Column = myarr End If End With With ListBox1 For i = 1 To 12 deg = deg & CLng(Columns(i + 1).Width) & ";" Next i .ColumnWidths = deg End With If TextBox9.Text = "" Then ListBox1.Clear End If Application.ScreenUpdating = True TextBox10.Value = ListBox1.ListCount End Sub Private Sub TextBox9_Enter() For a = 0 To 8 Controls("textbox" & a + 1) = "" Next TextBox10 = "0" TextBox11 = "" TextBox12 = "" TextBox13 = "" TextBox14 = "" ListBox1.Clear End Sub Private Sub UserForm_Initialize() Dim sonsat As Long Sheets("liste").Activate CommandButton2.Enabled = False CommandButton3.Enabled = False Me.Top = 40 Me.Left = 80 OptionButton1.Value = True sonsat = Sheets("liste").Cells(Rows.Count, 1).End(xlUp).Row Range("A" & sonsat & ":I" & sonsat).Interior.ColorIndex = 25 ComboBox1.Enabled = False End Sub Sub listbox_refresh() Dim sat As Long sat = Cells(Rows.Count, "A").End(xlUp).Row ListBox1.List = Sheets("liste").Range("B2:M" & sat).Value With ListBox1 For i = 1 To 12 deg = deg & CLng(Columns(i + 1).Width) & ";" Next i .ColumnWidths = deg End With ListBox1.ColumnCount = 12 'ListBox1.ListIndex = 0 End Sub Sub text_boxes_clear() For a = 1 To 14 Controls("textbox" & a) = "" Next a End Sub Sub sort_id() Dim k As Long On Error Resume Next For k = 2 To Cells(Rows.Count, "A").End(xlUp).Row Cells(k, 1).Value = k - 1 Next k End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Call CommandButton5_Click End Sub ****'CODE OF THE MODULE**** Sub ac() UserForm2.Show End Sub Sub add_sheets() Dim m As Byte Workbooks.Open (ThisWorkbook.Path & "\Database.xls") For m = 1 To Sheets.Count UserForm2.ComboBox1.AddItem Sheets(m).Name Next m ActiveWorkbook.Close True UserForm2.ComboBox1.Enabled = True End Sub