title: Can't execute macro for more than one items from listbox
body: <p>I am a newbie. I've just written a code which copies a range of cells with looking the first 3 number of the number in the left adjacent column of those cells. For Ex: if the first three number of A1 and A5 is 100 than copy B1:D1 and B5:D5 to a new workbook. At the beginning I was using inputbox to enter the number (100) to find the range that I want to copy. Now I want to use multiple inputs. Like I want to copy cells that are at the right of 100 to a new workbook and cells that are right of 120 to another new workbook with just one code... I wrote a code with using listbox. However the problem is whenever I choose multiple items like 100 110 120 it doesn't work. It copies right adjacent cells of the cells that contains 100 to a new workbook, than again it copies right cells of 100 to another new workbook. I am stuck and waiting for a person to enlight me. Sorry for my english, I am not a native speaker. Anyway here is the code:</p>
  
  <pre><code>Private Sub Userform_Initialize()
  With ListBox1
  .AddItem "100"
  .AddItem "110"
  .AddItem "120"
  End With
  
  ListBox1.ListIndex = 0
  
  End Sub
  
  Private Sub OKButton_Click()
  
  Dim c As Range
  Dim rRng As Range
  Dim LRow As Range
  Dim rRng2 As Range
  Dim i As Integer
  
  ChDir "C:\Users\Loff1\Desktop\CreatedBD"
  
  
  For i = 0 To ListBox1.ListCount - 1
  If ListBox1.Selected(i) = True Then
  LedAcc = ListBox1.List(i)
  
  
  For Each c In Workbooks("Test.xlsx").Sheets("TestBD").Range("A2:A100")
  
      If LedAcc = Left(c, 3) Then
  
          If rRng Is Nothing Then
              Set rRng = c
          Else
              Set rRng = Application.Union(rRng, c)
          End If
      End If
  Next
  
  Set rRng2 = rRng.Offset(0, 3)
  
  Workbooks("Test.xlsx").Sheets("TestBD").Select
  Range(rRng, rRng2).Select
  Selection.Copy
  
  Set NewBook = Workbooks.Add
  NewBook.Sheets("Sheet1").Select
  Range("B9").Select
  ActiveSheet.Paste
  
  Range("A6").Value = LedAcc
  ThisFile = Range("A6").Value
  NewBook.SaveAs Filename:=ThisFile
  Workbooks(ThisFile &amp; ".xlsx").Close SaveChanges:=False
  
  End If
  
  Next i
  
  End Sub
  </code></pre>