Sige,
I didn't post working code, just what would prompt you to pick one code or
the other.
Below is working code.
HTH,
Bernie
MS Excel MVP
Sub Sige2Working()
Dim ThisBook As Workbook
Dim ExpBook As Workbook
Dim nme As Name
Dim myAddress As String
Set ThisBook = ActiveWorkbook
Set ExpBook = Workbooks.Add
ThisBook.Activate
For Each nme In ThisBook.Names
If Left(nme.Name, 3) = "VBA" Then
MsgBox nme.Name
myAddress = Range(nme).Address
Range(nme).Copy _
ExpBook.Worksheets(1).Range(myAddress)
End If
Next nme
ExpBook.SaveAs Filename:=ThisWorkbook.Path & "\temp.xls", _
FileFormat:=xlWorkbook
ExpBook.Close SaveChanges:=False
End Sub
"SIGE" wrote in message
...
Hi Bernie,
Your first solution each rang to own workbook:
Code runs fine ... workbooks created ...except that it does not paste
the ranges into the respective workbooks.
Sub sige()
Dim ThisBook As Workbook
Dim ExpBook As Workbook
Dim nme As Name
Dim counter As Integer
Set ThisBook = ActiveWorkbook
counter = 0
For Each nme In ThisBook.Names
If Left(nme.Name, 3) = "VBA" Then
Set ExpBook = Workbooks.Add(xlWorksheet)
counter = counter + 1
MsgBox nme.Name
With ExpBook
Range(nme).Copy .Worksheets(1).Range(Range(nme).Address)
.SaveAs Filename:=ThisWorkbook.Path & "\temp" & counter &
".xls", FileFormat:=xlWorkbook
.Close SaveChanges:=False
If Err < 0 Then MsgBox "Cannot export" & _
ThisWorkbook.Path & "\temp.xls"
End With
Else
MsgBox "No names to export"
Exit Sub
End If
Next nme
End Sub
Your 2nd solution: all named ranges to single wbk.
Is actually where I am after.
I run into the same error as on Tom's code.
Run time error'438':Object does not support this property or method on:
Worksheets(1).Range (Range(nme).Address)
Sub sige2()
Dim ThisBook As Workbook
Dim ExpBook As Workbook
Dim nme As Name
Set ThisBook = ActiveWorkbook
Set ExpBook = Workbooks.Add(xlWorksheet)
With ExpBook
For Each nme In ThisBook.Names
If Left(nme.Name, 3) = "VBA" Then
MsgBox nme.Name
Range(nme).Copy
.Worksheets(1).Range (Range(nme).Address)
End If
If Err < 0 Then MsgBox "Cannot export" & _
ThisWorkbook.Path & "\temp.xls"
Next nme
.SaveAs Filename:=ThisWorkbook.Path & "\temp.xls", _
FileFormat:=xlWorkbook
.Close SaveChanges:=False
End With
End Sub
I am sorry ... it is beyond my skills!
Sige
"NOSPAM" to be removed for direct mailing...
*** Sent via Developersdex http://www.developersdex.com ***