Copying multiple named ranges onto a Consolidation worksheet

Here is a macro that loops through both the global and local named range collections. It stores the consolidation data on a worksheet named Consolidation. Column A is the name, column B is the worksheet name, and column C are the values. Existing data on worksheet Consolidation is cleared at the start of the macro.

When testing on Excel 2013, I found that the local named range collection duplicated the results of the global looping, so I commented that block of code out. It might be required in earlier versions, however.

Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .Cells.ClearContents
    .Range("A1:C1").Value = Array("Name", "Worksheet", "Values")
    For Each nm In ActiveWorkbook.Names
        Set rg = nm.RefersToRange
        i = .UsedRange.Row + .UsedRange.Rows.Count
        .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
        .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
    Next
    
    'This next block of code is not required in Excel 2013
    'For Each ws In ActiveWorkbook.Worksheets
        'For Each nm In ws.Names
            'Set rg = nm.RefersToRange
            'i = .UsedRange.Row + .UsedRange.Rows.Count
            '.Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            '.Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
        'Next
    'Next
End With
End Sub

Select allOpen in new window

As written, the macro does not run automatically. It could be called by a Workbook_WorksheetChange event macro, however. In so doing, any change on any open worksheet would cause the consolidation range to update. Note that you would need to sandwich the macro call between two statements toggling the value of Application.EnableEvents to avoid an infinite cycle of triggering the Workbook_WorksheetChange sub.

Because such an approach would involve considerable overhead, you may want to consider an alternative approach using the Worksheet_Activate event sub. When the user activates the Consolidation worksheet, the consolidation report is updated. You don't need to worry about toggling events with this approach.

I get a run-time error '1004' : Application-defined or object-defined error
on this line :
Set rg = nm.RefersToRange. I use excel 2013.

Trying to implement in my workbook, I notice this happens on as soon as it starts looping on the second name.

Any ideas?

What is the RefersTo for that second name? I'd like to reproduce your problem at my end.

I added error testing in case the named range doesn't exist in the version of the macro below. You won't get the error previously reported, but neither will the macro report the contents of that range.

Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .Cells.ClearContents
    .Range("A1:C1").Value = Array("Name", "Worksheet", "Values")
    For Each nm In ActiveWorkbook.Names
        Set rg = Nothing
        On Error Resume Next
        Set rg = nm.RefersToRange
        On Error GoTo 0
        If Not rg Is Nothing Then
            i = .UsedRange.Row + .UsedRange.Rows.Count
            .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
        End If
    Next
End With
End Sub

Select allOpen in new window

See attached.

No more errors but no values either...(I'd like to choose the columns to consolidate if that is possible).

I've added a little msgbox and I noticed that the range names are not consistent. How can I define thescope of each locally instead of globally?

Perhaps the issue is something else.
MASTER.xlsm

I was not able to replicate your problems with a run-time error, even though I use 32-bit Excel 2013. The macro below has error handling commented out.

When I stepped through the code, I noticed that the row counter i was 1324 when the first named range was being processed. I therefore changed the way that worksheet Consolidation is cleared when the macro starts. I also changed the header labels on worksheet Consolidation.

Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .UsedRange.EntireRow.Delete
    .Range("A1:C1").Value = Array("Nom", "Feuille", "Valeurs")
    For Each nm In ActiveWorkbook.Names
        Set rg = Nothing
        'On Error Resume Next
        Set rg = nm.RefersToRange
        'On Error GoTo 0
        If Not rg Is Nothing Then
            i = .UsedRange.Row + .UsedRange.Rows.Count
            MsgBox i & " : " & nm.Name
            .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
        End If
    Next
End With
End Sub

Select allOpen in new window

Which column(s) do you want from the named ranges in your Consolidation report?
MASTERnamedRangeConsolidationQ28.xlsm

Since not all sheets does have the same number of columns and that once consolidated they need to fit together, I need two separate logics when pasting to the consolidation sheet (is it also possible to paste format ???)

I'll implement the conditions myself when it's looping but the logics are the following :

logic #1 (column #s below)
1,2,3,7,8,9,14,15,16,17,18,19,20

logic #2 (column #s below, "0" means that I need to insert 0 in the cell via code while looping in orde to have the same # of columns)
1,2,3,4,5,6,11,14,"0",13,"0",12,15

Please note that I cannot simply loop range columns from left to right because of logic #2.

Thanks

I've added logic to paste the formats as well as values. There are two statements involved. One pastes just values and number formats. The other pastes all formats. If you don't need borders, fonts, highlighting and other formatting copied over, comment out the latter--your macro will run faster.

I also added logic to copy over just certain columns of the named ranges according to two logics. The macro chooses between those logics based on worksheet name, but you could make it based on named range name just as easily. The "Else" block covers all other named ranges--those are copied over in entirety.

Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long, j As Long
Dim v As Variant, vLogic1 As Variant, vLogic2 As Variant
Application.ScreenUpdating = False
vLogic1 = Array(1, 2, 3, 7, 8, 9, 14, 15, 16, 17, 18, 19, 20)
vLogic2 = Array(1, 2, 3, 4, 5, 6, 11, 14, 0, 13, 0, 12, 15)
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .UsedRange.EntireRow.Delete
    .Range("A1:C1").Value = Array("Nom", "Feuille", "Valeurs")
    For Each nm In ActiveWorkbook.Names
        Set rg = Nothing
        'On Error Resume Next
        Set rg = nm.RefersToRange
        'On Error GoTo 0
        If Not rg Is Nothing Then
            i = .UsedRange.Row + .UsedRange.Rows.Count
            j = 0
            'MsgBox i & " : " & nm.Name
            .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            Select Case rg.Worksheet.Name
            Case "PRÉLIM-MEP", "TEST"
                For Each v In vLogic1
                    j = j + 1
                    If v > 0 Then
                        With .Cells(i, j + 2).Resize(rg.Rows.Count, 1)
                            rg.Columns(v).Copy
                            .PasteSpecial xlPasteValuesAndNumberFormats
                            .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                        End With
                    End If
                Next
            Case "FORMATION", "DICTIONNAIRE"
                For Each v In vLogic2
                    j = j + 1
                    If v > 0 Then
                        With .Cells(i, j + 2).Resize(rg.Rows.Count, 1)
                            rg.Columns(v).Copy
                            .PasteSpecial xlPasteValuesAndNumberFormats
                            .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                        End With
                    End If
                Next
            Case Else   'Paste all columns
                rg.Copy
                With .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count)
                    .PasteSpecial xlPasteValuesAndNumberFormats
                    .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                End With
            End Select
        End If
    Next
End With
End Sub

Select allOpen in new window

I've added some tweaking to your code so it works with additional logics of mine. One last request if I may, for the blank columns of logic2: how can I format these columns based on the same range columns right next to their left or right (I need both) of the blank columns?

Let's say the first 0 column has to have the same format than the range column directly to its left and for the second 0, it must be based on the range column directly to its right.

Since they are created manually, I have the correct format everywhere but for those two added columns.

Thanks

Perfect, thanks !