VBA to autofilter on a certain column, copy and paste into new sheet, loop through list

[imeade]

Hello,

I currently have a macro that does the following:

• Two ranges named on the [Reference] worksheet
• Based on named range "LenderCode" on the [Reference] worksheet, filter on the column "Reference-2" on the [Data] worksheet for the named range
• Copy filtered data and paste into new worksheet
• Rename new worksheet based on the "SheetName" named range on [Reference] worksheet

The macro below works just fine, but I want to incorporate a loop on the named range "LenderCode" that will complete the steps for each referenced named range (B4:B28), but it also needs to incorporate the "SheetName" reference (C4:C28) to rename the each new worksheet


Sub Filter1()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim i As Integer
Dim rngData As Range
Dim LenderCode As Range
Dim SheetName As Range

Sheets("Data").Select
ActiveSheet.Range("a1").Select

Set rngData = Range("A1").CurrentRegion
i = Application.WorksheetFunction.Match("Reference-2", Range("A1:BZ1"), 0)

Set LenderCode = Sheets("Reference").Range("B4")
Set SheetName = Sheets("Reference").Range("C4")

rngData.AutoFilter Field:=i, Criteria1:=LenderCode

On Error GoTo Dupe

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
ActiveSheet.Paste


Sheets("Data").Select
ActiveSheet.Range("a1").Select
Selection.AutoFilter

Call allOrigin

GoTo Finish

Dupe:
MsgBox ("Worksheet [" & SheetName & "] already exists, please delete respective sheet"), vbCritical, "UCC Template"
ActiveSheet.Delete
Sheets("Reference").Select
ActiveSheet.Range("a1").Select
Selection.AutoFilter
'GoTo Finish



Finish:
Sheets("Reference").Select
ActiveSheet.Range("a1").Select
Selection.AutoFilter
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub



Thanks for the help!

Ian