****al,
Try like:
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
keepITcool
< email : keepitcool chello nl (with @ and .)
< homepage:
http://members.chello.nl/keepitcool
"****al" wrote:
code is given below which is working for copy printarea
and paste in new workbook with which ever is name
cell "C9" with paste as a value.
but is this copy only sheet1 printarea i want to copy
more than one sheet printarea. I want to copy user
printarea from sheet1, sheet2 & sheet3 and save into new
workbook with which eaver is name in sheet1 cell "C9".
any Help.
****al