Copy Range Issue

[SIGE]

Hello,
Would like to copy all the Ranged Names starting with "VBA" to a new workbook.
1. Syntax jams on :
Range(nme.Name).Copy '''''GRRRRRRR'''''''
2. I do not create a new workbook for every name I am exporting do I?

Sige

Sub sige()
Dim ThisBook As Workbook
Dim ExpBook As Workbook
Dim nme As Name

Set ThisBook = ActiveWorkbook
Set ExpBook = Workbooks.Add(xlWorksheet)
For Each nme In ThisBook.Names
If Left(nme.Name, 3) = "VBA" Then
MsgBox nme.Name
Range(nme.Name).Copy '''''GRRRRRRR'''''''

With ExpBook
.Worksheets(1).Range(Range(nme.Name).Address).Paste
.SaveAs FileName:=ThisWorkbook.Path & "\temp.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

 

[Don Guillett]

Have a look in insert>name>define to see what your vba names refer to

 

[SIGE]

Hi Don,

I created those names through VBA, thats why I give them a name
beginning with "VBA"...

and they refer to sortalike ranges:
=Sheet1!$B$4:$B$27
...

Sige


"NOSPAM" to be removed for direct mailing...

*** Sent via Developersdex http://www.developersdex.com ***

 

[Bernie Deitrick]

Sige,

For Each nme In ThisBook.Names
If Left(nme.Name, 3) = "VBA" Then
MsgBox nme.Name
With ExpBook
Range(nme).Copy .Worksheets(1).Range(Range(nme).Address) '''''
No mor GRRRRRRR'''''''


HTH,
Bernie
MS Excel MVP

 

[Don Guillett]

If the name of the name is
vba5
vba6
etc
then us

Sub eachname()
For Each n In Names
If UCase(Left(n.Name, 3)) = "VBA" Then MsgBox n.Name
Next
End Sub

 

[SIGE]

Hi Bernie,

Thanks .... but "Still Grrr" ;o)

On :
Range(nme).Copy .Worksheets(1).Range(Range(nme).Address) '''''No mor
GRRRRRRR'''''''

I get an Run-time error- '2147221080(800401a8)':Automation error.

Sige Grrr )))

"NOSPAM" to be removed for direct mailing...

*** Sent via Developersdex http://www.developersdex.com ***

 

[Bernie Deitrick]

Sige,

You have all sorts of other problems with the code, due to bad logic. You
copy for one name, then save and close the workbook. Your flow might be
this, if you want to export wach named range to its own workbook

Dim counter As Integer
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

If you want to export all the named ranges to a single workbook, then it
would be

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)
If Err <> 0 Then MsgBox "Cannot export" & _
ThisWorkbook.Path & "\temp.xls"
End With
End If
Next nme

.SaveAs Filename:=ThisWorkbook.Path & "\temp.xls", _
FileFormat:=xlWorkbook
.Close SaveChanges:=False

End With

HTH,
Bernie
MS Excel MVP

 

[Tom Ogilvy]

Sub sige()
Dim ThisBook As Workbook
Dim ExpBook As Workbook
Dim nme As Name
Dim rng as Range

Set ThisBook = ActiveWorkbook
Set ExpBook = Workbooks.Add(xlWorksheet)
For Each nme In ThisBook.Names
If Left(Ucase(nme.Name, 3)) = "VBA" Then
MsgBox nme.Name
set rng = nme.ReferstoRange
rng.copy

With ExpBook
.Worksheets(1).Range(rng.Address).Paste
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
With ExpBook
.SaveAs FileName:=ThisWorkbook.Path & "\temp.xls", _
FileFormat:=xlWorkbook
.Close SaveChanges:=False
End With
End Sub

 

[SIGE]

Hi Tom,

Took your code and pasted it in a normal module.

1. Run into: Compile error:
Wrong number of arguments or invalid property assignment on:
UCase
2. When removing the Ucase-part:
If Left(nme.Name, 3) = "VBA" Then

I run into Run-time error"438"
Object does not support this property or method on :

..Worksheets(1).Range(rng.Address).Paste


I do not do it on purpose ...! )
Sige


"NOSPAM" to be removed for direct mailing...

*** Sent via Developersdex http://www.developersdex.com ***

 

[SIGE]

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

 

[Bernie Deitrick]

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

 

[Tom Ogilvy]

My fault on that code:

Worksheets(1).Paste Worksheets(1).Range(rng.Address)

If Left(Ucase(nme.Name, 3)) = "VBA" Then

should be

If Left(Ucase(nme.Name), 3) = "VBA" Then

My typo

 

[SIGE]

Tom, Bernie,

Don't know which status is coming after MVP ... they should invent it!!!
Works great!
Thanks, thanks, thanks a million!

Sige

"NOSPAM" to be removed for direct mailing...

*** Sent via Developersdex http://www.developersdex.com ***

 

[SIGE]

Just stretching a little more:

If I want to just "Paste Special" those ranges (values and formats)...
like:
Selection.PasteSpecial Paste:=xlValues

Not so trivial to get this "PasteSpecial" it into your code.

Lalalala Sige





"NOSPAM" to be removed for direct mailing...

*** Sent via Developersdex http://www.developersdex.com ***

 

[Tom Ogilvy]

.Worksheets(1).Paste .Worksheets(1).Range(rng.Address)

would be

.worksheets(1).Range(rng.Address).PasteSpecial xlValues
.worksheets(1).Range(rng.Address).PasteSpecial xlFormats

I haven't looked at Bernie's code, so if using that, perhaps something
similar.

 

[SIGE]

Thanks Tom!!!

"NOSPAM" to be removed for direct mailing...

*** Sent via Developersdex http://www.developersdex.com ***