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
 

what i want is to copy 3 sheets & save them into new
workbook with what ever name in sheet1 in cell "c9"

Try this
Sub test()
Dim wb As Workbook
Application.ScreenUpdating = False
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Sheets("Sheet1").Range("C9") & ".xls"
End With
Application.ScreenUpdating = True
End Sub




--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2002 SP-2)
www.rondebruin.nl



"****al" wrote in message ...
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