title: VBA for copying selected data to new workbooks
body: <p>I have a list in Excel from which I need to filter and copy selected data from a workbook to a bunch of new (not yet existing) workbooks. Here's what needs to be done:</p>
  
  <p>In the main file there's a  table consisting of columns A-Z. In column A there are 250 unique different values which are used for sorting the data. The list needs to be looped through and filtered by each value in column A. With every filtering action all rows sharing the same values should be copied (along with column headers) and pasted in a new workbook. The new workbook needs to be created and named using the value in column A.</p>
  
  <p>I'm a newbie when it comes to VBA and any help would be greatly appreciated. </p>
  
  <p>Edit: Here's some code I found on a different forum (credit to WarPigl3t over at mrexcel.com) that I've trying to use. It seems to do all I need (and also some extra stuff with timestamp that's not really needed). However the .SaveAs part of the macro fails for some reason.</p>
  
  <pre><code>Sub CopySelectedData()
  nameColumn = "A"
  headerRow = 1
  firstRow = 2
  
  mainWB = getWorkbookName(ThisWorkbook.Name)
  mainSht = ActiveSheet.Name
  lastRow = Workbooks(mainWB).Sheets(mainSht).Range("A"  &amp; Rows.Count).End(xlUp).Row
  filePath = getFilePath(ActiveWorkbook)
  timeStamp = getTimeStamp()
  Call createNewDirectory(filePath, timeStamp)
  arrayOfNames = createArrayOfNames(mainWB, mainSht, firstRow, lastRow, nameColumn)
  Call createNewWorkbook(mainWB, mainSht, nameColumn, headerRow, firstRow, lastRow, filePath, timeStamp, arrayOfNames)
  End Sub
  
  Function getWorkbookName(WB_Name)
  mySplit = Split(WB_Name, ".")
  getWorkbookName = mySplit(0)
  End Function
  
  Function getFilePath(WB) As String
  getFilePath = WB.Path
  End Function
  
  Function getTimeStamp()
  myNow = Now
  myNow = Replace(myNow, "/", "-")
  myNow = Replace(myNow, ":", "`")
  getTimeStamp = myNow
  End Function
  
  Sub createNewDirectory(filePath, folderName)
  MkDir (filePath &amp; "/" &amp; folderName)
  End Sub
  
  Function createArrayOfNames(mainWB, mainSht, firstRow, lastRow, nameColumn)
  a = 0
  Dim myArrayOfNames() As String
  ReDim Preserve myArrayOfNames(a)
  r = firstRow
  Do Until r &gt; lastRow
      myValue = Workbooks(mainWB).Sheets(mainSht).Range(nameColumn &amp; r).Value
      addNewElementToArrayOfNames = True
      For Each element In myArrayOfNames()
          If element = myValue Then
              addNewElementToArrayOfNames = False
          End If
      Next element
      If addNewElementToArrayOfNames = True Then
          ReDim Preserve myArrayOfNames(a)
          myArrayOfNames(a) = myValue
          a = a + 1
      End If
      r = r + 1
  Loop
  createArrayOfNames = myArrayOfNames()
  End Function
  
  Sub createNewWorkbook(mainWB, mainSht, nameColumn, headerRow, firstRow, lastRow, filePath, timeStamp, arrayOfNames)
  For Each element In arrayOfNames
      Set newWB = Workbooks.Add
      With newWB
          .SaveAs Filename:=filePath &amp; "\" &amp; timeStamp &amp; "\" &amp; element &amp; ".xls"
          newWB_Name = getWorkbookName(newWB.Name)
          Call createMonthlyData(newWB_Name, mainWB, mainSht, nameColumn, headerRow, firstRow, lastRow, element)
          newWB.Save
          newWB.Close
      End With
  Next element
  End Sub
  
  Sub createMonthlyData(newWB_Name, mainWB, mainSht, nameColumn, headerRow, firstRow, lastRow, arrayName)
  Workbooks(mainWB).Sheets(mainSht).Rows(headerRow).Copy
  ActiveSheet.Paste Destination:=Workbooks(newWB_Name).Sheets("Blad1").Rows(headerRow)
  nextRow = firstRow
  r = firstRow
  Do Until r &gt; lastRow
      nameValue = Workbooks(mainWB).Sheets(mainSht).Range(nameColumn &amp; r).Value
      If nameValue = arrayName Then
          Workbooks(mainWB).Sheets(mainSht).Rows(r).Copy
          ActiveSheet.Paste Destination:=Workbooks(newWB_Name).Sheets("Blad1").Rows(nextRow)
          nextRow = nextRow + 1
      End If
      r = r + 1
  Loop
  End Sub
  </code></pre>