我是Excel VBA的新手。
请查看附件。
我无法将特定数据保存到另一个已关闭的工作簿中。 因为每次我复制数据并将其保存到目标工作簿的特定工作表时，它都会覆盖现有数据。
我想要的是每次从列表框复制过滤后的数据并将其发送到目标工作簿时，不断添加数据。
老实说，我只下载这个文件，我想用它作为我们的记录
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