copy 3 sheets & save them into new workbook
 

I recv. msg. on 4th oct. 03 but when i run the code it's
gives error given below.

"Run-time error '1004'
Application-defined or object-defined error."

what i want is to copy 3 sheets & save them into new
workbook with what ever name in sheet1 in cell "c9"
Sub CopyPA()
Dim wbS As Workbook
Dim wbT As Workbook
Dim w As Worksheet
Dim s As Variant
Dim a As Variant

Set wbS = ActiveWorkbook 'Alternative ThisWorkbook?
a = Array("sheet1", "sheet2", "sheet3")

'Verify PrintAreas
On Error Resume Next
For Each w In wbS.Worksheets(a)
If w.Names("Print_Area") Is Nothing Then s = s & w.Name
& vbNewLine
Next
On Error GoTo 0

If Not IsEmpty(s) Then
MsgBox "PrintArea not set in " & vbNewLine & s
Exit Sub
End If

'Create book & sync sheetnames
Set wbT = Workbooks.Add(xlWBATWorksheet)
wbT.Sheets(1).Name = a(0)
For s = 1 To UBound(a)
Set w = wbT.Worksheets.Add(after:=Sheets(Sheets.Count))
w.Name = a(s)
Next

'Store Values in Target
For Each w In wbT.Worksheets
With Range(wbS.Names(w.Name & "!print_area").RefersTo)
.Value = wbS.Names(w.Name & "!
print_area").RefersToRange.Value
End With
Next

'Save & Close
wbT.Close True, wbS.Sheets(1).Range("c9").Text

End Sub

plz help.

****al

..

copy 3 sheets & save them into new workbook
 

This is a guess based on where your message wrapped lines in your post:

You may have had a typo:

With Range(wbS.Names(w.Name & "!print_area").RefersTo)
.Value = wbS.Names(w.Name & "!print_area").RefersToRange.Value
End With

It looks like there might have been an extra space around the "print_area" on
the second line.

But it looks like you could avoid a little typing by:

With Range(wbS.Names(w.Name & "!print_area").RefersTo)
.Value = .Value
End With

And I think I'd be a little more careful--just in case there's a worksheet that
has spaces in them:

With Range(wbS.Names("'" & w.Name & "'" & "!print_area").RefersTo)
.Value = .Value
End With

(additional single quotes. You could combine that final single quote into the
next string:
"'" & "!print_area" into "'!print_area", too.)
==
If that wasn't the problem, how do you run the code and what version of xl are
you using. 1004 errors are sometimes caused by a bug in xl97 (fixed in xl2k)
when the macro was run by using a control from the control toolbox toolbar.

(If you used a commandbutton from the controltoolbox toolbar, turn the
..takefocusonclick property to false. If you used a control that doesn't have a
..takefocusonclick property, then add this line to the top of your code:

activecell.activate




****al wrote:

I recv. msg. on 4th oct. 03 but when i run the code it's
gives error given below.

"Run-time error '1004'
Application-defined or object-defined error."

what i want is to copy 3 sheets & save them into new
workbook with what ever name in sheet1 in cell "c9"
Sub CopyPA()
Dim wbS As Workbook
Dim wbT As Workbook
Dim w As Worksheet
Dim s As Variant
Dim a As Variant

Set wbS = ActiveWorkbook 'Alternative ThisWorkbook?
a = Array("sheet1", "sheet2", "sheet3")

'Verify PrintAreas
On Error Resume Next
For Each w In wbS.Worksheets(a)
If w.Names("Print_Area") Is Nothing Then s = s & w.Name
& vbNewLine
Next
On Error GoTo 0

If Not IsEmpty(s) Then
MsgBox "PrintArea not set in " & vbNewLine & s
Exit Sub
End If

'Create book & sync sheetnames
Set wbT = Workbooks.Add(xlWBATWorksheet)
wbT.Sheets(1).Name = a(0)
For s = 1 To UBound(a)
Set w = wbT.Worksheets.Add(after:=Sheets(Sheets.Count))
w.Name = a(s)
Next

'Store Values in Target
For Each w In wbT.Worksheets
With Range(wbS.Names(w.Name & "!print_area").RefersTo)
.Value = wbS.Names(w.Name & "!
print_area").RefersToRange.Value
End With
Next

'Save & Close
wbT.Close True, wbS.Sheets(1).Range("c9").Text

End Sub

plz help.

****al

.

--

Dave Peterson