View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Copy Range Issue

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 ***