VBA Code to Copy and Paste 100+ Named Ranges with Looping

[Meegan_Brown]

Hi- I am new to learning VBA and I need some help! I am looking for a VBA code that will loop through all 50 tabs within an excel workbook and search for any named range that starts with EQUITY and copy and paste all named ranges into one single tab within the workbook. In this case we can name that tab MASTER.

I explored using Paste Range and specified ranges like so:

Sub PasteRange()

Range("EQUITYO1JY").Copy
Range("A2").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

End Sub

This was fine until I realized I'll have close to over 100 named ranges, and I would have to update the code if a new named range were to be added, as well as a location for it to be pasted to.

As a note, all named ranges have the same number of columns, however the number of rows varies. (Not sure if this makes a difference)

Any help would be much appreciated!

 

[DanteAmor]

Hi and welcome to MrExcel.


Try the following code:

Sub Copy_Range_Name()
    Dim wName As Name, wEqui As String
    Dim ws As Worksheet, u As Double
    
    Application.ScreenUpdating = False
    
    Set ws = Sheets("Master")
    ws.Range("2:" & Rows.Count).ClearContents
    
    For Each wName In ActiveWorkbook.Names
        If LCase(Left(wName.Name, 6)) = LCase("EQUITY") Then
            Range(wName.RefersTo).Copy
            u = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws.Range("A" & u).PasteSpecial xlPasteValues
        End If
    Next
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "End"
End Sub

 

[Meegan_Brown]

Thank you! This is perfect and exactly what I was looking for.

Hi and welcome to MrExcel.


Try the following code:

Sub Copy_Range_Name()
    Dim wName As Name, wEqui As String
    Dim ws As Worksheet, u As Double
    
    Application.ScreenUpdating = False
    
    Set ws = Sheets("Master")
    ws.Range("2:" & Rows.Count).ClearContents
    
    For Each wName In ActiveWorkbook.Names
        If LCase(Left(wName.Name, 6)) = LCase("EQUITY") Then
            Range(wName.RefersTo).Copy
            u = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws.Range("A" & u).PasteSpecial xlPasteValues
        End If
    Next
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "End"
End Sub

 

[DanteAmor]

I'm glad to help you. I appreciate your kind comments.