VBA для копирования выбранных данных в новые рабочие книги

Question

У меня есть список в Excel, из которого мне нужно отфильтровать и скопировать выбранные данные из рабочей книги в кучу новых (еще не существующих) рабочих книг.Вот что нужно сделать:

В основном файле есть таблица, состоящая из столбцов AZ.В столбце А есть 250 уникальных различных значений, которые используются для сортировки данных.Список должен проходить и фильтроваться по каждому значению в столбце A. При каждом действии фильтрации все строки с одинаковыми значениями должны копироваться (вместе с заголовками столбцов) и вставляться в новую рабочую книгу.Новая книга должна быть создана и названа с использованием значения в столбце A.

Я новичок, когда дело доходит до VBA, и любая помощь будет принята с благодарностью.

Редактировать: Вот код, который я нашел на другом форуме (спасибо WarPigl3t на mrexcel.com), который я пытаюсь использовать.Кажется, он делает все, что мне нужно (а также некоторые дополнительные вещи с меткой времени, которые на самом деле не нужны).Однако часть макроса .SaveAs по какой-то причине не работает.

Sub CopySelectedData()
nameColumn = "A"
headerRow = 1
firstRow = 2

mainWB = getWorkbookName(ThisWorkbook.Name)
mainSht = ActiveSheet.Name
lastRow = Workbooks(mainWB).Sheets(mainSht).Range("A"  & 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 & "/" & 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 > lastRow
    myValue = Workbooks(mainWB).Sheets(mainSht).Range(nameColumn & 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 & "\" & timeStamp & "\" & element & ".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 > lastRow
    nameValue = Workbooks(mainWB).Sheets(mainSht).Range(nameColumn & 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