CODEWITHSUNDEEP
vbaexcelnamed-ranges
Fredrik_S
Fredrik_S

Reputation: 21

Need VBA for loop referencing a named range which contains all the sheet names

I have a piece of "crude" code which copies some data from one sheet to Another, and the sheet-name from which the data is copied can be found in a cell. However, the number of sheets are now growing, and I have created a dynamic named range for the sheetnames, and would like to perform the following code for all the sheets in the dynamic range. My code looks like this:

Calculate

' get the worksheet name from cell AA3
Worksheets(Range("AA3").Value).Activate

' Copy the data 
Range("A1:A1500").Select
Selection.Copy

' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Select
Dim NextRow As Range
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Now, I would like to have something like a loop with reference to the dynamic range but I am unable to get it to work as VBA really is not my cup of tea...So, instead of referencing AA3, AA4 etc I would like to referebnce the named range which contains the data of AA3, AA4....AAx. The named range might also contain blank cells, as it is the result of an Array formula in AA3....AA150.

Thank you! /Fredrik

Upvotes: 1

Views: 2078

Answers (4)

Fredrik_S
Fredrik_S

Reputation: 21

-= Problem Solved =-

Thank you all for your contribution to my question! All the answers that I received has helped me refine my code, which is now functioning properly!

Regards, Fredrik

Upvotes: 0

Vegard
Vegard

Reputation: 4882

The following example loops through each cell in a named range by using a For Each...Next loop. If the value of any cell in the range exceeds the value of Limit, the cell color is changed to yellow.

vba
Sub ApplyColor() 
    Const Limit As Integer = 25 
    For Each c In Range("MyRange") 
        If c.Value > Limit Then 
            c.Interior.ColorIndex = 27 
        End If 
    Next c 
End Sub

Source

So you might start off with something like this:

Calculate

Dim NextRow As Range

' get a range object from the named range
For Each c In Range("[File.xls]Sheet1!NamedRange")

    ' Copy the data 
    Worksheets(c.Value).Range("A1:A1500").Copy

    ' Paste the data on the next empty row in sheet "Artiklar"
    Sheets("Artiklar").Activate
    Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
    NextRow.PasteSpecial xlPasteValues

Next c

You'll notice that I was a bit more explicit with how the named range is being referred to - the requirement here might vary depending on how you declared the range to begin with (what its scope is), but the way I did it will most likely work for you. See the linked article for more information about scope of named ranges.

Upvotes: 0

user3598756
user3598756

Reputation: 29421

Dim myNamedRng as Range, cell as Range
'...
Set myNamedRng = Worksheets("MySheet").Range("myRange") '<-- set a variable referencing your named Range
With Sheets("Artiklar")
    For Each cell In myNamedRng
        If cell.Value <>"" Then .Range("A"  & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1500).Value = Worksheets(cell.Value).Range("A1:A1500").Value
    Next cell
End With

Upvotes: 0

Marco Vos
Marco Vos

Reputation: 2968

The following code should work for you. I assumed that the named range (i called it copysheets) is in the active workbook (scope workbook).

Sub copySheets()

Dim sheetName As Range
Dim copyRange As Range
Dim destinationRange As Range

For Each sheetName In Range("copysheets")

  If sheetName.Value <> "" And sheetName.Value <> 0 Then

    Set copyRange = Sheets(sheetName.Value).Range("A1:A1500")    
    Set destinationRange = Sheets("Artiklar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    copyRange.Copy
    destinationRange.PasteSpecial xlPasteValues

  End If

Next

End Sub

Upvotes: 0

Related Questions