![]()
![]()
I'm using Excel VBA to do this. But this sub seems to copy everything from sheet 1 to sheet 2? Please advise. I want only multiple selected items in ListBox to be copy. Does anyone know good VB site for beginner? ListBox guide? MSDN too deep for me.
Thanks for all!![]()
VB Code:
Sub GenSelectedSQL() Dim rngColC As Range Dim strFirstAddress As String Dim rngNextResult As Range Dim rngNextSearch As Range Dim i As Long Dim c As Long Set rngColC = Sheets("Sheet1").Range("C:C").CurrentRegion With UserForm1.ListBox1 For i = 0 To .ListCount - 1 ' first listbox index is 0! Set rngNextResult = rngColC.Find(What:=ListBox1.List(i, 0), LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not rngNextResult Is Nothing Then 'copy row and paste it somewhere rngNextResult.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(rngNextResult.Row, 1) End If 'now if there's a match, find any others If Not rngNextResult Is Nothing Then Do 'change the search range to the remainder of the range Set rngNextSearch = Range(rngNextResult, rngColC.End(xlDown)) Set rngNextResult = rngNextSearch.FindNext(rngNextResult) strFirstAddress = rngNextResult.Address If Not rngNextResult Is Nothing Then rngNextResult.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(rngNextResult.Row, 1) End If Loop While Not rngNextResult Is Nothing And rngNextResult.Address <> strFirstAddress End If Next i End With End Sub




Reply With Quote