Loop through code based on Range Names

[mrattenborough]

THe Code below is repeated for each range name. THe issue is that the code exceeds 64k when all range names are accounted for and wont compile. I am sure there is a better way to do this and would appreaciate any guidence.

The Range names would change at NoRecords = Range("RangeName").value and Selection.AutoFilter Field:=1, Criteria1:=AreaHotel4Name and Range("SPAH4").Select. Other than that the code is the same for each range name.

I have approx 70 Range names that I need to process.


'Check to see if there is any data for this Plan
NoRecords = Range("SPAH4Rows").Value
If NoRecords > -11 Then

'Find Last Row
LastRow = Range("A65536").End(xlUp).Row

Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("A1:G" & LastRow - 1).Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=AreaHotel4Name
CurrRow = ActiveCell.Row + 1

'Refresh Last Row based on returned set
LastRow = Range("A65536").End(xlUp).Row

Range("B" & CurrRow, "F" & LastRow).Select

Selection.Copy
Sheets("Smart Plans").Select
Range("SPAH4").Select
Application.Range(ActiveCell, ActiveCell.End(xlToLeft)).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Goto Action Plans
With Sheets("Action Plan Input")
.Activate

'Clear AutoFilter
ActiveSheet.AutoFilterMode = False
End With

End If


Any assistance is appreciated. Thank you

 

[mrattenborough]

Bump

Thank you