Vba 将特定数据复制到另一个已关闭的工作簿

我是Excel VBA新手

请参阅附件

我在将特定数据保存到另一个关闭的工作簿时遇到问题。 因为每次复制数据并将其保存到目标工作簿的特定工作表时，它都会覆盖现有数据

我想要的是每次从listbox复制筛选数据并将其发送到目标工作簿时，不断添加数据

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

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

Dim a，i为字节，deg为字符串
私有子命令按钮1_单击（）
昏暗的桑萨，最后一排一样长，阿拉一样远
如果TextBox1.Text=“”或TextBox3.Text=“”，则
MsgBox“数据不完整”，vbCritical“
TextBox1.SetFocus
出口接头
如果结束
lastrow=工作表（“列表”）。单元格（Rows.Count，“B”）。结束（xlUp）。行
sonsat=Sheets（“liste”）。单元格（Rows.Count，“A”）。结束（xlUp）。行+1
设置ara=Range（“B2:B”和lastrow）。查找（What:=TextBox1.Text，LookIn:=xlValues，LookAt:=xlWhole）
如果不是，那么ara什么都不是
MsgBox“此名称已存在！请尝试其他名称”，vbCritical“
TextBox1.SetFocus
出口接头
如果结束
单元（sonsat，1）=sonsat-1
单元格（sonsat，2）=文本框1
单元格（sonsat，3）=文本框2
单元格（sonsat，4）=文本框3
单元格（sonsat，5）=文本框4
单元格（sonsat，6）=文本框5
单元格（sonsat，7）=文本框6
单元格（sonsat，8）=文本框7
单元格（sonsat，9）=文本框8
单元格（sonsat，10）=文本框11
单元格（sonsat，11）=文本框12
单元格（sonsat，12）=文本框13
单元格（sonsat，13）=文本框14
范围（“A”&sonsat&“：M”&sonsat）。Font.ColorIndex=11
MsgBox“注册成功”，vbInformation“
范围（“A”&sonsat&“：M”&sonsat）。Interior.ColorIndex=25
调用排序id
调用文本框\u清除
端接头
专用子命令按钮10_单击（）
如果ListBox1.ListCount=0，则
MsgBox“没有将被复制的项目”，vbCritical“
出口接头
如果结束
调用添加工作表
如果ComboBox1.Value=”“，则
MsgBox“请从下拉列表中选择工作表”，vbInformation“
ComboBox1.SetFocus
出口接头
如果结束
工作簿.Open（ThisWorkbook.Path&“\Database.xls”）
工作表（ComboBox1.Value）。使用drange.Cells.Clear
工作表（ComboBox1.Value）.Range（“A2:L”&ListBox1.ListCount+1）=ListBox1.List
工作表（ComboBox1.Value）.Columns.AutoFit
ActiveWorkbook.Close为真
MsgBox“已复制列表框记录。”，vbInformation“
组合框1.清除
ComboBox1.Enabled=False
Application.ScreenUpdating=True
端接头
私有子命令按钮2_单击（）
朦胧的桑萨，最后一排一样长，或者像绳子一样长
如果TextBox1.Text=“”或TextBox3.Text=“”，则
MsgBox“未选择要更改的项目”，vbCritical“
出口接头
如果结束
sor=MsgBox（“您确定吗？”，vbYesNo，”）
如果sor=vbNo，则退出Sub
lastrow=工作表（“列表”）。单元格（Rows.Count，“B”）。结束（xlUp）。行
工作表（“列表”）.Range（“B2:B”和lastrow）.查找（内容：=ListBox1.Text，查找：=xlValues，查找：=xlWhole）.激活
sonsat=ActiveCell.Row
单元格（sonsat，2）=文本框1
单元格（sonsat，3）=文本框2
单元格（sonsat，4）=文本框3
单元格（sonsat，5）=文本框4
单元格（sonsat，6）=文本框5
单元格（sonsat，7）=文本框6
单元格（sonsat，8）=文本框7
单元格（sonsat，9）=文本框8
单元格（sonsat，10）=文本框11
单元格（sonsat，11）=文本框12
单元格（sonsat，12）=文本框13
单元格（sonsat，13）=文本框14
范围（“A”&sonsat&“：M”&sonsat）。Font.ColorIndex=11
MsgBox“项目已更改”，vbInformation“
调用列表框\u刷新
调用文本框\u清除
列表框1。清除
CommandButton3.Enabled=False
CommandButton2.Enabled=False
CommandButton1.Enabled=True
端接头
私有子命令按钮3_单击（）
作为字符串的Dim cevap
如果ListBox1.ListIndex>=0，则
cevap=MsgBox（“条目将被删除……您确定吗？”，vbYesNo，”）
如果cevap=vbYes，则
lastrow=工作表（“列表”）。单元格（Rows.Count，“B”）。结束（xlUp）。行
工作表（“列表”）.Range（“B2:B”和lastrow）.查找（内容：=ListBox1.Text，查找：=xlValues，查找：=xlWhole）.激活
工作表（“列表”）.Rows（ActiveCell.Row）.删除
如果结束
其他的
MsgBox“未选择要删除的项目”，vbCritical“
出口接头
如果结束
列表框1。清除
调用文本框\u清除
调用排序id
CommandButton2.Enabled=False
CommandButton3.Enabled=False
CommandButton1.Enabled=True
端接头
私有子命令按钮5_单击（）
对于a=1到14
控件（“文本框”和a）=“”
下一个
列表框1。清除
CommandButton1.Enabled=True
CommandButton2.Enabled=False
CommandButton3.Enabled=False
组合框1.清除
ComboBox1.Enabled=False
端接头
私有子命令按钮6_单击（）
对于a=1到14
控件（“文本框”和a）=“”
下一个
单击调用命令按钮5
UserForm2.Hide
端接头
私有子命令按钮7_单击（）
迪姆坐了很久
sat=单元格（Rows.Count，“A”）。结束（xlUp）。行
ListBox1.List=Sheets（“liste”）.Range（“B2:M”和sat）.Value
使用ListBox1
对于i=1到12
deg=deg和CLng（柱（i+1）.宽度）和“
接下来我
.柱宽=度
以
ListBox1.ColumnCount=12
TextBox10.Value=ListBox1.ListCount
端接头
私有子命令按钮8_单击（）
列表框1。清除
调用文本框\u清除
CommandButton1.Enabled=True
端接头
私有子列表框1_单击（）
我说，最后一排一样长
TextBox1=ListBox1.列（0）
TextBox2=ListBox1.列（1）
TextBox3=ListBox1.列（2）
TextBox4=ListBox1.列（3）
TextBox5=ListBox1.列（4）
TextBox6=ListBox1.列（5）
TextBox7=ListBox1.列（6）
TextBox8=ListBox1.列（7）
TextBox11=ListBox1.列（8）
TextBox12=ListBox1.列（9）
TextBox13=ListBox1.列（10）
TextBox14=ListBox1.列（11）
lastrow=工作表（“列表”）。单元格（Rows.Count，“B”）。结束（xlUp）。行
工作表（“列表”）.Range（“B2:B”和lastrow）.查找（内容：=ListBox1.Value，查找：=xlValues，查找：=xlWhole）.激活
say=ActiveCell.Row
工作表（“列表”）。范围（“A”&say&“：M”&say）。选择
CommandButton1.Enabled=False
CommandButton2.Enabled=True
CommandButton3.Enabled=True
端接头
私有子SpinButton1_向下扩展（）
出错时继续下一步
如果ListBox1.ListIndex=ListBox1.ListCount-1，则退出Sub
和我一起
.