Save specific sheets to new workbooks adding tomorrow's date to na

[TryingToFigureItAllOut]

My company refuses to use a database to collect data so I'm stuck
distributing Excel workbooks everyday with specific sheets to different
offices, consolidating the inputs in one workbook, then updating the separate
workbooks with the information from consolidated workbook. The piece of VBA
code that I haven't figured out is copying Sheet 1, 4, 6 to workbook 1, sheet
1, 3, 5 to workbook 2, and sheet 1, 2, 7 to workbook 3 from the master and
adding tomorrow's date to the end of each file name.

 

[Matthew Herbert]

My company refuses to use a database to collect data so I'm stuck
distributing Excel workbooks everyday with specific sheets to different
offices, consolidating the inputs in one workbook, then updating the separate
workbooks with the information from consolidated workbook. The piece of VBA
code that I haven't figured out is copying Sheet 1, 4, 6 to workbook 1, sheet
1, 3, 5 to workbook 2, and sheet 1, 2, 7 to workbook 3 from the master and
adding tomorrow's date to the end of each file name.

TryingToFigureItAllOut,

You can set the code up to do more of a loop to remove some of the
redundancy, but the syntax for what you are looking to do is below (or
at least one way to do it is below).

Best,

Matthew Herbert

Sub CopySheetsToNewBook()
Dim wkbOne As Workbook
Dim wkbTwo As Workbook
Dim wkbThr As Workbook
Dim varOne As Variant
Dim varTwo As Variant
Dim varThr As Variant
Dim myDate As Date
Dim intWkb As Integer

varOne = Array(1, 4, 6)
varTwo = Array(1, 3, 5)
varThr = Array(1, 2, 7)

myDate = Date + 1

Set wkbOne = Workbooks.Add
Set wkbTwo = Workbooks.Add
Set wkbThr = Workbooks.Add

With ThisWorkbook
.Worksheets(varOne).Copy wkbOne.Worksheets(1)
.Worksheets(varTwo).Copy wkbTwo.Worksheets(1)
.Worksheets(varThr).Copy wkbThr.Worksheets(1)
End With

wkbOne.Close True, ThisWorkbook.Path & "\One-" & Format(myDate, "mm-dd-
yy") & ".xls"
wkbOne.Close True, ThisWorkbook.Path & "\Two-" & Format(myDate, "mm-dd-
yy") & ".xls"
wkbOne.Close True, ThisWorkbook.Path & "\Thr-" & Format(myDate, "mm-dd-
yy") & ".xls"

End Sub