Generate new workbook and add a template header with multiple rows - excel

Question

I have compiled a Macro to generate new workbooks based on unique values i the original workbook. Then it copies the rows related to thees values into the new workbook. This works great.
However I also want a template to be copied after this process and inserted as new rows in the new workbook. I am having trouble activating this new workbook to run these actions.
I am guessing that the new workbook needs to be set to something so I can use this as a reference. To later be used in this part: Windows("newBook").Activate. Or should this part be written completely different?
And when should the new workbook be saved to set it´s name?
Using this part ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & ".xlsx", 51
This is what I have so far:
Option Explicit
Sub DataExport()
'Declare variables
Dim ArrayItem As Long
Dim ws As Worksheet
Dim NewBook As Workbook
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range
Set ws = Sheets("Data")
Set NewBook = 'what?
'The save path for the files created
SavePath = Range("FolderPath")
'Variables for the column to separate data based on
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Data[#Headers]"), 0)
ColumnHeadingStr = "Data[[#All],[" & Range("ExportCriteria").Value & "]]"
'Turn off screen updating to save runtime
Application.ScreenUpdating = False
'Creates a temporary list of unique values
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("UniqueValues"), Unique:=True
'Sort the temporary list of unique values
ws.Range("UniqueValues").EntireColumn.Sort Key1:=ws.Range("UniqueValues").Offset(1, 0), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Add unique field values into an array
ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))
'Delete the temporary values
ws.Range("UniqueValues").EntireColumn.Clear
'Loop through the array of unique field values. Then copy paste into new workbooks and save.
For ArrayItem = 1 To UBound(ArrayOfUniqueValues)
ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
ws.Range("Data[#All]").SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll ' pastes all values
Columns(1).EntireColumn.Delete
'saving the new workbook. Should it be places somewhere else?
ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & ".xlsx", 51
'here is where the trouble starts
Windows("REFERENCE with export VB.xlsm").Activate
Sheets("Template").Select
Rows("1:5").Select
Selection.Copy
'Now the tricky part on how to go back to the new workbook
Windows("newBook").Activate
Rows("1:1").Select
Selection.Insert Shift:=xlDown
'Saving and closing
ActiveWorkbook.Save
ActiveWorkbook.Close False
ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt
Next ArrayItem
ws.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True
End Sub

Answer 1

I've tried to explain the code so it makes sense. I don't know what do you actually want to do with the copied rows from the sheet templates, I've assumed you wanted to paste the format to the first 5 rows of your new workbok...
Option Explicit
Sub DataExport()
'Turn off screen updating to save runtime
Application.ScreenUpdating = False 'do it at the beginning of your code
'Declare variables
'try to declare your variables just before using them so it's easier to know what do they do.
'Dim rng As Range you are not using this
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Data") 'always reference workbook and worksheet
'The save path for the files created
Dim SavePath As String
SavePath = Range("FolderPath")
With ws 'you can use this to reference this worksheet using only a dot
'Variables for the column to separate data based on
Dim ColumnHeadingInt As Long
ColumnHeadingInt = WorksheetFunction.Match(.Range("ExportCriteria").Value, .Range("Data[#Headers]"), 0)
Dim ColumnHeadingStr As String
ColumnHeadingStr = "Data[[#All],[" & .Range("ExportCriteria") & "]]"
'Creates a temporary list of unique values
.Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("UniqueValues"), Unique:=True
'Sort the temporary list of unique values
.Range("UniqueValues").EntireColumn.Sort Key1:=ws.Range("UniqueValues").Offset(1, 0), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Add unique field values into an array
Dim ArrayOfUniqueValues As Variant
ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))
'Delete the temporary values
.Range("UniqueValues").EntireColumn.Clear
End With 'here ends the reference to your ws sheet
'You shouldn't declare anything inside a loop, so you do it just before.
Dim NewBook As Workbook
'Loop through the array of unique field values. Then copy paste into new workbooks and save.
Dim ArrayItem As Long
For ArrayItem = LBound(ArrayOfUniqueValues) To UBound(ArrayOfUniqueValues)
.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
.Range("Data[#All]").SpecialCells(xlCellTypeVisible).Copy
'Here you use the NewBook variable.
Set NewBook = Workbooks.Add 'you can use the workbook variable like this
With NewBook.Sheets(1)
.Range("A1").PasteSpecial xlPasteAll ' pastes all values
.Columns(1).EntireColumn.Delete
.Rows("1:1").Insert Shift:=xlDown
End With
'here is where the trouble starts this block can be resumed in one line of code
' Windows("REFERENCE with export VB.xlsm").Activate
' Sheets("Template").Select
' Rows("1:5").Select
' Selection.Copy
'ThisWorkbook always refers to the workbook running the code
ThisWorkbook.Sheets("Template").Rows("1:5").Copy
With NewBook 'again reference the new workbook
'This I think is what you want to do, paste formats from rows 1 to 5 on your Template sheet
.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
'saving the new workbook. Should it be places somewhere else?
'Should be placed just before the last operation so you don't need to save multiple times
.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & ".xlsx", 51
.Close
End With
ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt
Next ArrayItem
ws.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True
End Sub