Copy two sheets into new files and save to multiple locations

[XP]

Using Excel 2007 and Win XP;

I run a VBA program that sets up several sheets. Now I want to code a
distribution program that copies two of the sheets, one called "Find" and
another called "REQ" from the "program file" into a new file, then copy that
file out to three different network locations for users to view/use.

Any assistance/shortcuts you could offer in the code to do this would be
most appreciated.

Thanks in advance.

 

[ProfessionalExcel.com]

Something like the following should help (you will need to set the network
locations):

Sub DistributeSheets()

Dim wkbNew As Workbook
Dim strNetworkLocation1 As String
Dim strNetworkLocation2 As String
Dim strNetworkLocation3 As String

'Set location
strNetworkLocation1 = "D:\1\test.xls"
strNetworkLocation2 = "D:\2\test.xls"
strNetworkLocation3 = "D:\3\test.xls"

'Create new workbook and copy sheets
Set wkbNew = Workbooks.Add
ThisWorkbook.Sheets("Find").Copy Before:=wkbNew.Sheets(1)
ThisWorkbook.Sheets("REQ").Copy Before:=wkbNew.Sheets(1)

'Delete unwanted sheets
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
Application.DisplayAlerts = True
On Error GoTo 0

'Save in location 1
wkbNew.SaveAs Filename:=strNetworkLocation1
wkbNew.Close
Set wkbNew = Nothing

'Copy file to other locations
FileCopy strNetworkLocation1, strNetworkLocation2
FileCopy strNetworkLocation1, strNetworkLocation3

End Sub

Please rate this post if it ansers your question.

Thanks,

Chris
www.ProfessionalExcel.com

 

[XP]

I'll tweak and give it a go; thanks!

Something like the following should help (you will need to set the network
locations):

Sub DistributeSheets()

Dim wkbNew As Workbook
Dim strNetworkLocation1 As String
Dim strNetworkLocation2 As String
Dim strNetworkLocation3 As String

'Set location
strNetworkLocation1 = "D:\1\test.xls"
strNetworkLocation2 = "D:\2\test.xls"
strNetworkLocation3 = "D:\3\test.xls"

'Create new workbook and copy sheets
Set wkbNew = Workbooks.Add
ThisWorkbook.Sheets("Find").Copy Before:=wkbNew.Sheets(1)
ThisWorkbook.Sheets("REQ").Copy Before:=wkbNew.Sheets(1)

'Delete unwanted sheets
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
Application.DisplayAlerts = True
On Error GoTo 0

'Save in location 1
wkbNew.SaveAs Filename:=strNetworkLocation1
wkbNew.Close
Set wkbNew = Nothing

'Copy file to other locations
FileCopy strNetworkLocation1, strNetworkLocation2
FileCopy strNetworkLocation1, strNetworkLocation3

End Sub

Please rate this post if it ansers your question.

Thanks,

Chris
www.ProfessionalExcel.com