saving 3 worksheets in a workbook to a separte workbook

[bigjim]

I'm using Excel 2003 and I want use vba to save 3 of the sheets in a workbook
to a new workbook with a new name generated each time. I can save one but I
can't figure out how to save three. For example, I want to copy three sheets
named temp1, temp2, and temp3 to a new workbook created and named in the
original workbook, so that workbook 2 will contain only copies of sheets,
temp1, temp2, and temp3. Any help will be greatly appreciated.

 

[Bernard Liengme]

Here is a start:

Sub Macro3()
ActiveWorkbook.SaveCopyAs "NewBook.xlsm"
Workbooks.Open Filename:="NewBook.xlsm"
For Each ws In Worksheets
If ws.Name = "temp1" Or ws.Name = "temp2" Or ws.Name = "temp3" Then
'do nothing
Else
ws.Delete
End If
Next
Workbooks("NewBook.xlsm").Save

End Sub

best wishes

 

[Chip Pearson]

Try code like the following:

Sub AAA()
ThisWorkbook.Worksheets("Sheet1").Copy
With ActiveWorkbook
ThisWorkbook.Worksheets("Sheet2").Copy _
after:=.Worksheets(.Worksheets.Count)
ThisWorkbook.Worksheets("Sheet3").Copy _
after:=.Worksheets(.Worksheets.Count)
End With
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[bigjim]

Interesting approach. I never thought of doing it that way. I'll give it a
try.

Thanks,

 

[bigjim]

OK, here is the code that I'm using:
Dim strappend As String
Dim strpath As String
Dim str3 As String

strappend = ActiveSheet.Range("j6")
strpath = "c:\field tickets\"
str3 = ActiveSheet.Range("c6")

fsavename = strpath & strappend & str3 & ".xls"
If Dir(fsavename) <> "" Then
fsavename = strpath & strappend & str3 & "a.xls"

End If
If Dir(fsavename) <> "" Then
fsavename = strpath & strappend & str3 & "b.xls"
End If

If Dir(fsavename) <> "" Then
fsavename = strpath & strappend & str3 & "c.xls"
End If

If Dir(fsavename) <> "" Then
fsavename = strpath & strappend & str3 & "d.xls"
End If
If Dir(fsavename) <> "" Then
fsavename = strpath & strappend & str3 & "e.xls"
End If
If Dir(fsavename) <> "" Then
fsavename = strpath & strappend & str3 & "f.xls"
End If
If Dir(fsavename) <> "" Then
fsavename = strpath & strappend & str3 & "g.xls"
End If

ActiveWorkbook.SaveCopyAs "NewBook.xls"
Workbooks.Open Filename:="NewBook.xls"
For Each ws In Worksheets
If ws.Name = "Type I tail Encana-EOG f" Or ws.Name = "Type I tail Encana-EOG
jr f" Or ws.Name = "Type I tail Encana-EOG w15 f" Then
'do nothing
Else
ws.Delete
End If
Next



Workbooks("NewBook.xls").SaveAs fsname




ActiveWorkbook.Close True

Workbooks("North Texas Sep 8 2007 Cmt Price Bookbu1105.xls").Select

The first time I ran it, It gave me a message and I had to hit "delete" on
each sheet. First of all I need to get rid of that if possible.

Then when I ran it again, it stopped at the line:

ActiveWorkbook.SaveCopyAs "NewBook.xls"

with an error box saying it cannot acess "Newbook.xls"

I think this will work, if I can just get some of these issues cleaned up.
Any suggestions?

Thanks,

 

[bigjim]

Try code like the following:

Sub AAA()
ThisWorkbook.Worksheets("Sheet1").Copy
With ActiveWorkbook
ThisWorkbook.Worksheets("Sheet2").Copy _
after:=.Worksheets(.Worksheets.Count)
ThisWorkbook.Worksheets("Sheet3").Copy _
after:=.Worksheets(.Worksheets.Count)
End With
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Bernard Liengme]

Chip's method is better - the macro stays in the original workbook and is
not duplicated in the second one