PDA

View Full Version : Copy select data to different column



Uding2014
12-25-2016, 01:47 AM
Please help how to copy select data from userform to different column

see below VBA :


Private Sub CheckBox1_Click()
Dim r As Long
If CheckBox1.Value = True Then
For r = 0 To ListBox2.ListCount - 1
ListBox2.Selected(r) = True
Next r
Else
For r = 0 To ListBox2.ListCount - 1
ListBox2.Selected(r) = False
Next r
End If
End Sub

Private Sub cmdbul1_Click()
Dim isim As Range
Application.ScreenUpdating = False
Sheets("Dataform").Activate
If TextBox1 = Empty Then
MsgBox "Please enter A Value To Search"
TextBox1.SetFocus
Exit Sub
End If
ListBox2.RowSource = Empty
ListBox2.Clear
ListBox2.ColumnCount = 9
For Each isim In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
liste = ListBox2.ListCount
ListBox2.AddItem
ListBox2.List(liste, 0) = isim
ListBox2.List(liste, 1) = isim.Offset(0, 1)
ListBox2.List(liste, 2) = isim.Offset(0, 2)
ListBox2.List(liste, 3) = isim.Offset(0, 3)
ListBox2.List(liste, 4) = isim.Offset(0, 4)
ListBox2.List(liste, 5) = isim.Offset(0, 5)
ListBox2.List(liste, 6) = isim.Offset(0, 6)
ListBox2.List(liste, 7) = isim.Offset(0, 7)
ListBox2.List(liste, 8) = Format(isim.Offset(0, 8), "dd.mm.yyyy")
End If
Next
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
Dim Litem As Long, LbRows As Long, LbCols As Long
Dim bu As Boolean
Dim Lbloop As Long, Lbcopy As Long
LbRows = ListBox2.ListCount - 1
LbCols = ListBox2.ColumnCount - 1
For Litem = 0 To LbRows
If ListBox2.Selected(Litem) = True Then
bu = True
Exit For
End If
Next
If bu = True Then
With Sheets("CopyfromDataform").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For Litem = 0 To LbRows
If ListBox2.Selected(Litem) = True Then
Lbcopy = Lbcopy + 1
For Lbloop = 0 To LbCols
.Cells(Lbcopy, Lbloop + 1) = ListBox2.List(Litem, Lbloop)
Next Lbloop
End If
Next
For m = 0 To LbCols
With Sheets("CopyfromDataform").Cells(Rows.Count, 1).End(xlUp).Offset(0, m).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 23
End With
Next
End With
Else
MsgBox "Nothing chosen", vbCritical
End If
MsgBox "The Selected Data Are succes Copied.", vbInformation
Sheets("CopyfromDataform").Select
End Sub

Private Sub CommandButton2_Click()
Dim del As Control
For Each del In UserForm1.Controls
If TypeName(del) = "TextBox" Then
del.Text = Empty
End If
Next del
UserForm_Initialize
End Sub

Private Sub CommandButton3_Click()
Unload Me
End Sub

Private Sub OptionButton1_Click()
ListBox2.MultiSelect = 0
End Sub

Private Sub OptionButton2_Click()
ListBox2.MultiSelect = 1
End Sub

Private Sub OptionButton3_Click()
ListBox2.MultiSelect = 2
End Sub

Private Sub UserForm_Initialize()
Dim say As Integer
Application.ScreenUpdating = False
say = WorksheetFunction.CountA(Worksheets("Dataform").Range("A:A"))
ListBox2.RowSource = "Dataform!A2:I" & say
ListBox2.ColumnCount = 9
ListBox2.ColumnWidths = "60;60;60;60;60;60;60;60;60"
ListBox2.MultiSelect = fmMultiSelectMulti
OptionButton3.Value = True
Application.ScreenUpdating = True
End Sub

p45cal
12-27-2016, 10:33 AM
see reply at your other thread:
http://www.vbaexpress.com/forum/showthread.php?58089-Copy-select-data-on-USERFORM