title: Trying to create new workbooks based off data
body: <p>Trying to create new workbooks based off of data. works for one set of data but wont work for more. I have tested for 22- and 11- separately and it works but wont work together.  llllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll</p>
  
  <pre><code>Dim rw As Long, lastrow As Long, MySel As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("Sheet1")
      For rw = 1000 To 2 Step -1
          If .Cells(rw, 8).Value Like "*22-*" Then
              If MySel Is Nothing Then
                  Set MySel = .Cells(rw, 1).EntireRow
  
                      Else
                          Set MySel = Union(MySel, .Cells(rw, 1).EntireRow)
  
  
  
                      Dim sWorkbook As Workbook
  
                       'Create New Workbook
                      Set sWorkbook = Workbooks.Add
  
                       'Save Above Created New Workbook
                       sWorkbook.SaveAs Filename:="C:\CODE\22 Production.xlsx"
  
  
                      End If
                  End If
              Next rw
          End With
  
  With Workbooks("22 Production").Worksheets("Sheet1")
      lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySel Is Nothing Then
          MySel.Copy Destination:=.Cells(lastrow + 1, 1)
          'MySel.Delete
      End If
  End With
  
  Dim rw1 As Long, lastrow1 As Long, mysel1 As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("Sheet1")
      For rw1 = 1000 To 2 Step -1
          If .Cells(rw1, 8).Value Like "*11-*" Then
              If mysel1 Is Nothing Then
                  Set mysel1 = .Cells(rw1, 1).EntireRow
  
                      Else
                          Set mysel1 = Union(mysel1, .Cells(rw1, 1).EntireRow)
  
  
  
                      Dim sWorkbook1 As Workbook
  
                       'Create New Workbook
                      Set sWorkbook1 = Workbooks.Add
  
                       'Save Above Created New Workbook
                       sWorkbook1.SaveAs Filename:="C:\CODE\11 Production.xlsx"
  
  
                      End If
                  End If
              Next rw1
          End With
  
  With Workbooks("11 Production").Worksheets("Sheet1")
      lastrow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not mysel1 Is Nothing Then
          mysel1.Copy Destination:=.Cells(lastrow1 + 1, 1)
          'mysel1.Delete
      End If
  End With
  </code></pre>
  
  <p>Subscript out of range</p>