Copy info of a name range

Hi,

Today I’m facing a new challenge because I want to copy all the information from a name range from a different workbook and paste it in my activeworkbook , but the trouble that I’m having is that it doesn’t copy all the cells of the name range, just the first cell of the name range.

Here is the command that I’m using, not sure if it’s the best approach

[VBA]ThisWorkbook.Worksheets("US Input").Range("usInput").Value = Workbooks("US Input File.xlsm").Worksheets("US Input").Range("usInput").Value[/VBA]

Forgot to clarify that the name range is the same for both workbooks and it’s a discontinuous range

Any help would be much appreciated

Discontinous Range is a problem.

I would use something like

[VBA]Dim sourceRange As Range
Dim DestinationRange as Range
Dim I as Long

Set sourceRange = Workbooks("otherBook.xlsm").Names("usInput").RefersToRange
Set DestinationRange = ThisWorkbook.Names("usInput").RefersToRange

For I = 1 to sourceRange.Areas.Count
DestinationRange.Areas(I).Value = SourceRange.Areas(I)
Next I[/VBA]

Hi mikerickson, thank you so much for your quick answer, I really appreciate it

I’m getting an error (“Application-defined or object-defined error”) on
[VBA]
Set sourceRange = Workbooks("otherBook.xlsm").Names("usInput").RefersToRange [/VBA]

Sounds like usinput refers to a formula somewhere in it's string

[VBA]Sub test()
MsgBox Names("usinput").RefersTo
'If the return is too long
'NewSheet.Range("A1") = "'" & Names("usinput").RefersTo
End Sub
[/VBA]

Hey SamT , good talking to you again,

I checked and yes, on that range I’m also trying to copy the formulas, but I didn't fully understand your solution, can you clarify? I’m using mike’s code

Thank you so much for helping me

Oh, that wasn't a solution. It was a troubleshooting aid to see if there were formulas in the Names.

Try this, it is not tested.
[VBA]Dim sName As Name
Dim dName As Name
Dim I As Long
Dim B1 As Workbook
Set B1 = Workbooks("Otherbook.xls")
Dim B2 As WorkBook
Set B2 = ThisWorkBook

For I = 1 To B1.Names.Count

Range(B1.Names(I)).Value.Copy Range(B2.Names(I))

Next I
[/VBA]

I think we are getting close but I’m getting an error “Method Range of object_Global failed” with this line:

[VBA] Range(B1.Names(I)).Value.Copy Range(B2.Names(I))[/VBA]

Forgot to mention that I have different name ranges in both workbooks but I’m interested just in the “usInput” name range.

[VBA]
Dim rCopy As Range
Dim rPaste As Range
Set rCopy = B1.Range("usInput")
Set rPaste = B2.Range("usInput")

For i = 1 to rCopy.count
rCopy.Cells(i) Copy
rPaste.Cells(i).PasteSpecial(xlValues)
Next i[/VBA]

[VBA]Sub test_reftorange()
Dim wb As Workbook
Dim ws As Worksheet
Dim r As String
Dim nm As String
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
nm = "myrngname"
With ws.Range(nm)
r = "Row no. : " & .row & vbNewLine & "Col no. : " & .Column & vbNewLine & _
"Address : " & .Address & vbNewLine & "Value : " & .Value & vbNewLine & _
"Formula : " & .Formula & vbNewLine
MsgBox r
End With
Set wb = Nothing
Set ws = Nothing
End Sub[/VBA]

Hi All,
If we need to get the informations from the range name please try above ...

p.s.
this test only valid for one cell only,
if the range is more then value and formula does not work...
:dunno

Hey SamT,

Thank you so much for your help, I really appreciated.

I’ve been testing your code this morning and we are getting much closer now, the code it’s copying the first column successfully but not the rest of the columns of the name range .

Here is an image of how the name range look like in both workbooks.


Attachment 10176

Everything highlighted in yellow is part of the discontinuous name range.

So the code is copying column I without any problem but K-O , Q-R are not being copied
How can include the rest of the columns?

Thank you again Sam,

Lotuxel, I don’t fully understand your code to test it , doesn’t seem to be able to copy a range from one workbook to another , can you clarify ?

Referstorange doesn't apply to a noncontiguous range; use:

[vba]
Sub M_snb()
Sheets("Sheet2").Range("A1:A4,C1:E4,G1:H4").Name = "snb_002"
For Each ar In Split(Mid(ThisWorkbook.Names("snb_002").RefersTo, 2), ",")
Sheets("Sheet3").Range(Split(ar, "!")(1)).Value = Evaluate(ar).Value
Next
End Sub
[/vba]

Lotuxel,

Run this for me on one of the books and let me know if all the cells change color to almost black, and then back to the original color when you click a button in the MsgBox
[vba]Sub Test()
'Testing rCopy assignment

Dim rCopy As Range
Set rCopy = Range("usInput")

With rCopy.Interior
OldColor = .ColorIndex
.ColorIndex = 56
MsgBox "Check that all the Cells in usInput Changed Color"
.ColorIndex = OldColor
End With

End Sub
[/vba]

Edit: snb's will work,even if I won't understand it for another 3 hours. :)

Wow !!!, I ran some tests and snb’s code works tremendously well,

I want thank to the vbaexpress community that helped me out because without your help I couldn’t have done this myself

Snb
SamT
Mikerickson

Hats off to you guys, :bow:
And again, thank you so much, I really appreciate it

Alternative:
named range 1: snb_001
named range 2: snb_002

[vba]
Sub M_snb()
For Each it In [snb_001]
[snb_002].Cells(it.Row, it.Column) = it
Next
End Sub
[/vba]

Hi,

Today I’m using this code again but this time instead of values we need to copy the formulas of that name range, I’ve tried a few things but I can’t make it to work with formulas, How can I change it to copy the formulas?

[VBA]
Sub M_snb()
Sheets("Sheet2").Range("A1:A4,C1:E4,G1:H4").Name = "snb_002"
For Each ar In Split(Mid(ThisWorkbook.Names("snb_002").RefersTo, 2), ",")
Sheets("Sheet3").Range(Split(ar, "!")(1)).Value = Evaluate(ar).Value
Next
End Sub
[/VBA]


Any help would be much appreciated

Did you try ?

[VBA]
Sub M_snb()
For Each it In [snb_001]
[snb_002].Cells(it.Row, it.Column) = it.formula
Next
End Sub
[/VBA]

Hi snb,

Thank you so much for answering , the second approach that you posted originally was returning an error so I ended up using the first one, here is the code that I tried just now

[VBA]
For Each it In Workbooks(fnametwo).Names(CIGNrange)
ThisWorkbook.Names(CIGNrange).Cells(it.Row, it.Column) = it.Formula
Next
[/VBA]

That code has always returned an error on the first line but this one is working flawlessly

[VBA]
For Each ar In Split(Mid(Workbooks(fnametwo).Names(CIGNrange).RefersTo, 2), ",")
ThisWorkbook.Sheets(CIGWks).Range(Split(ar, "!")(1)).Value = Evaluate(ar).Formula
Next
[/VBA]

Thank you so much for helping me with this, I really appreciate it

Irevised some code:
to copy values
[vba]
Sub M_snb()
Sheets("Sheet2").Range("A1:A4,C1:E4,G1:H4").Name = "snb_002"
For Each ar In [snb_002].Areas
Sheets("sheet3").Range(ar.Address) = ar.Value
Next
End Sub
[/vba]to copy formulae:

[vba]
Sub M_snb()
Sheets("Sheet2").Range("A1:A4,C1:E4,G1:H4").Name = "snb_002"
For Each ar In [snb_002].Areas
Sheets("sheet3").Range(ar.Address) = ar.Formula
Next
End Sub
[/vba]

If the named range scope is 'worksheet', no reference to a sheet is being made

There is something that I’m doing wrong because even with the revised version the second approach returns an error , I’ll use the first approach because it’s working really good but here is my full code in case you want to take a look at it:

[VBA]
Sub Import_Data()



Dim fnametwo As String

Dim CIGNrange As String, CIGWks As String
Dim sName As Name
Dim dName As Name
Dim i As Long
Dim B1 As Workbook
Dim B2 As Workbook
Dim rCopy As String
Dim rPaste As String

', I As Integer

Dim fpath As String, fname As String, copyName As String, pass As String
Dim j As Integer
Dim wbMstr As Workbook, wbCopy As Workbook

' On Error GoTo Import_Data_Errorhandler

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableAnimations = False
.EnableEvents = False
.Calculation = xlCalculationManual
.StatusBar = Empty
.Cursor = xlDefault
End With

If Not IsFolderExistsID(cTEMP) Then
CreateObject("Scripting.FileSystemObject").CreateFolder cTEMP
End If


KillItID (sDebugLogFileNm)

WriteDebugLogID "----------------------------------------------------------------"
WriteDebugLogID (Now & " : user: " & Environ("username"))
WriteDebugLogID (Now & " : " & cAddInFileNm & " : Version: " & cAddInRev)
WriteDebugLogID "----------------------------------------------------------------"
WriteDebugLogID (Now & " : ImportData_Initialize started")


Set wbMstr = ThisWorkbook
With wbMstr
fpath = .Path & "\Output\"
End With

wbMstr.Worksheets("Country Input Generation").Select

For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
fname = fpath & Cells(1, j) & ".xlsm"
fnametwo = Cells(1, j) & ".xlsm"

Set wbCopy = Workbooks.Open(fname)
WriteDebugLogID (Now & " : Opening " & fnametwo & " from " & Path)
With ActiveWorkbook
For K = 2 To wbMstr.Worksheets("Country Input Generation").Cells(Rows.Count, 1).End(xlUp).Row
If wbMstr.Worksheets("Country Input Generation").Cells(K, j) <> "Hide" And wbMstr.Worksheets("Country Input Generation").Cells(K, j) <> "Show" Then



CIGNrange = wbMstr.Worksheets("Country Input Generation").Cells(K, j).Value
CIGWks = wbMstr.Worksheets("Country Input Generation").Cells(K, 1).Value

' Set B1 = Workbooks(fnametwo)
' Set B2 = ThisWorkbook
WriteDebugLogID (Now & " : Copying range " & CIGNrange & " from " & fname & "\" & CIGWks)

Workbooks(fnametwo).Activate

' For Each ar In Split(Mid(Workbooks(fnametwo).Names(CIGNrange).RefersTo, 2), ",")
' ThisWorkbook.Sheets(CIGWks).Range(Split(ar, "!")(1)).Value = Evaluate(ar).Value
' Next

'
' For Each ar In Split(Mid(Workbooks(fnametwo).Names(CIGNrange).RefersTo, 2), ",")
' ThisWorkbook.Sheets(CIGWks).Range(Split(ar, "!")(1)).Value = Evaluate(ar).Formula
' Next

For Each ar In Workbooks(fnametwo).Range(CIGNrange).Areas
ThisWorkbook.Sheets(CIGWks).Range(ar.Address) = ar.Formula
Next

Workbooks(fnametwo).Activate



End If
Next
.Close SaveChanges:=False
End With
wbMstr.Worksheets("Country Input Generation").Select
Next

wbMstr.Worksheets("Start").Select
frmComp.Show

WriteDebugLogID (Now & " : Importing complete ")

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableAnimations = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.StatusBar = Empty
.Cursor = xlDefault
End With


Exit Sub


Import_Data_Errorhandler:
Call LogErrorID("ImportData", Err.Number, Err.Description)

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableAnimations = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.StatusBar = Empty
.Cursor = xlDefault
End With


End Sub
[/VBA]