S
shital
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.
shital
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.
shital