VBA Code to Create new Workbooks and Move Saved Files

Hello Ozgrid Forum!

I am needing someone to show me how to build a VBA code to do all the things I want to do with the attached file (it is false info but will suffice for VBA test needs and to illustrate what I need accomplished). What I need to be able to do is have a VBA code that will:

1) Split the one TEST Booklet.xlsx worksheet('Sheet1') into multiple WorkBOOKS with specific file saved names in .xlsx format. I need the VBA to look down Column C (Department) and create a new WORKBOOK.xlsx for each unique list of Departments. Meaning that if the Department repeats then it needs to be on the same workbook and when the department changes to a different number, then a new workbook is created listing those departments. I need the header row to remain for each newly created file and in the same format as the original. Also, all corresponding row data needs to be repeated into the newly created workbooks (I don't want to end up with just a list of departments but all the data tied to each department (e.g., Market, Group, Location, Employee Number, etc...))

2) When the new workbook is created, I need the file saved to "C:\Workbooks" and with a specific file name for each. The file name needs to be Group-Department (example: Row 1 in my attached test file would need to be saved as 11-1103.xlsx. Row 4 should trigger a new workbook creation with a file save name of 12-1204.xlsx)

3) Once all the files are created and saved as the proper name in the "C:\Workbooks" folder, I need the VBA code to move (Not copy) the files to their final spot based on their Group. Meaning I will have a C:\Workbooks\11 folder, a C:\Workbooks\12 folder, a C:\Workbooks\13 folder, etc... I need the newly created files in the C:\Workbooks folder to be moved into their respective Group folders. So file name 11-1103.xlsx would need to be moved from C:\Workbooks into C:\Workbooks\11 and file name 12-1204.xlsx would need to be moved from C:\Workbooks into C:\Workbooks\12 folder. Make sense?

I know this is asking a lot without actually showing any work I've done to try to figure this out on my own but I honestly don't know where to begin on this one. If anyone can use the attached test document and make a macro accomplishing my needs, I can adjust it to work with my real data.

Thanks again for anyone willing to help out!!!

Re: VBA Code to Create new Workbooks and Move Saved Files

I've got something that I think will work for my needs for the most part but I am running into a compile error when pasting the data onto a new worksheet.

Sub split_data()Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 4
Set ws = Sheets("SCTR")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A13:AG13"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move After:=Worksheets(Worksheets.Count)
End If




'Original line below that pasted as a value but I need original source theme to remain
'ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")




ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
end sub

It errors here:

ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

I am getting error message Compile error: Expected: end of statement and it is highlighting the word "Paste" on the Paste:=xlPasteAllUsingSourceTheme

I have been googling how to address this but am at a loss. Any ideas for a fix?