Running multiple macros to create separate workbooks - vba

Question

I have a macro written to take selected sheets from one workbook, and copy those to another workbook, saving it under a new name. I need to run this same query repeatedly until I create about 6 separate files. Each individual macro works, and I can call them each up one at a time, but they will not run sequentially. I believe I know that the problem lies in the fact that the code I have written will not reference back to the source workbook, and I don’t know how to write code to do it.
The attached code is what I am using, and it may seem a bit sloppy – I put together pieces from several different macros to get this to work. Gqp Master is the name of the master workbook that all the other workbooks are being created from.
Sub Snuth()
'This will prevent the alet from popping up when overwriting graphs, etc
Application.DisplayAlerts = False
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
Dim strFileName As String
Dim WS As Worksheet
Dim WBk As Workbook
Set WBk = ("Gap Master")
For Each WS In Worksheets
WS.Visible = True
Next
For Each WS In Worksheets
If WS.Range("C4") <> "Snuth, John" Then
WS.Visible = False
End If
If WS.Range("C4") = "Snuth, John" Then
WS.Visible = True
End If
Next WS
FPath = "C:\Users\mmarshall\Documents\GAP\GAP Development"
FName = "Snuth GAP " & Format(Date, "yyyy-mm-dd") & ".xlsx"
Set NewBook = Workbooks.Add
ThisWorkbook.Sheets.Copy Before:=NewBook.Sheets(1)
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
ActiveWindow.SelectedSheets.Delete
If Dir(FPath & "\" & FName) <> "" Then
MsgBox "File " & FPath & "\" & FName & " already exists"
Else
NewBook.SaveAs Filename:=FPath & "\" & FName
End If
Application.DisplayAlerts = True
End Sub

Answer 1

I am assuming you have several other macros that do, more or less, the exact same thing, just for different manager names.
You can create a master subroutine that will invoke other subs/functions. What this does is send some arguments/parameters to a subroutine, these are
WBk: the workbook you're copying from
lastName: the manager's last name
firstName: the manager's first name
Here is the code:
Sub CreateCopies()
Dim WBk As Workbook
Set WBk = Workbooks("Gap Master")
'# Run the CopyForName for each of your manager names, e.g.:
CopyForName WBk, "Snuth", "John"
CopyForName WBk, "Zemens", "David"
CopyForName WBk, "Bonaparte", "Napoleon"
CopyForName WBk, "Mozart", "Wolfgang"
End Sub
Now, some revisions to your subroutine so that it is generic enough to perform the function for all managers:
Sub CopyForName(wkbkToCopy as Workbook, lastName as String, firstName As String)
'This will prevent the alert from popping up when overwriting graphs, etc
Application.DisplayAlerts = False
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
Dim strFileName As String
Dim WS As Worksheet
FPath = "C:\Users\mmarshall\Documents\GAP\GAP Development"
FName = lastName & " GAP " & Format(Date, "yyyy-mm-dd") & ".xlsx"
'## I consolidated your 3 loops in to 1 loop
For Each WS In wkbkToCopy.Worksheets
WS.Visible = (WS.Range("C4") = lastName & ", " & firstname)
Next
Set NewBook = Workbooks.Add
'Copies sheets from your Gap Master file:
wkbkToCopy.Sheets.Copy Before:=NewBook.Sheets(1)
'## I think you're trying to delete the default sheets in the NewBook:
NewBook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
If Dir(FPath & "\" & FName) <> "" Then
MsgBox "File " & FPath & "\" & FName & " already exists"
Else
NewBook.SaveAs Filename:=FPath & "\" & FName
NewBook.Close
End If
Application.DisplayAlerts = True
End Sub

Answer 2

Try this:
After your line:
NewBook.SaveAs Filename:=FPath & "\" & FName
insert:
NewBook.Close
This should cause you to "fall back" to the original workbook.

Answer 3

Try this:
Step1:
Change
Set WBk = ("Gap Master")
To
Set WBk = ActiveWorkbook
Step 2:
Also add another line:
Set NewBook = Workbooks.Add
WBk.Activate '''''add this line''''''
ThisWorkbook.Sheets.Copy Before:=NewBook.Sheets(1)

Answer 4

Here is what I came up with, cobbling together several different pieces of code:
Sub VPFiles()
Dim WBk As Workbook
Set WBk = ThisWorkbook
'# Run the CopyForName for each of your manager names, e.g.:
CopyForName WBk, "Doe", "Christopher"
CopyForName WBk, "Smith", "Mark"
CopyForName WBk, "Randall", "Tony"
CopyForName WBk, "Jordan", "Steve"
CopyForName WBk, "Marshall", "Ron"
End Sub
Followed By This:
Sub CopyForName(wkbkToCopy As Workbook, lastName As String, firstName As String)
'This will prevent the alert from popping up when overwriting graphs, etc
Application.DisplayAlerts = False
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
Dim strFileName As String
Dim WS As Worksheet
FPath = "\\filesrv1\department shares\Sales"
FName = lastName & " GAP " & Format(Date, "yyyy-mm-dd") & ".xlsx"
'## I consolidated your 3 loops in to 1 loop
For Each WS In wkbkToCopy.Worksheets
WS.Visible = (WS.Range("K4") = lastName & ", " & firstName)
Next
Set NewBook = Workbooks.Add
'Copies sheets from your Gap Master file:
wkbkToCopy.Sheets.Copy Before:=NewBook.Sheets(1)
'This delets all unnecessary sheets in the NewBook:
NewBook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
For Each WS In Worksheets
If WS.Visible <> True Then WS.Delete
Next
NewBook.SaveAs Filename:=FPath & "\" & FName
NewBook.Close
Application.DisplayAlerts = True
End Sub