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