Hi everyone,

I have the following codes:

Option Explicit

Sub Procedure1()
Dim N As Long
Dim URNRow As Long

For N = 2 To Sheets("Sheet1").Cells(Rows.Count, 13).End(xlUp).Row
    
    If WorksheetFunction.CountIf(Sheets("Sheet2").Range(Sheets("Sheet2").Columns(5), Sheets("Sheet2").Columns(10)), Sheets("Sheet1").Cells(N, 13)) > 0 Then
        URNRow = Sheets("Sheet2").Range(Sheets("Sheet2").Columns(5), Sheets("Sheet2").Columns(10)).Find(Sheets("Sheet1").Cells(N, 13), , xlValues, xlWhole).Row
        If Sheets("Sheet2").Cells(URNRow, 3).MergeArea(1) = Sheets("Sheet1").Cells(N, 31) Then
            Sheets("Sheet1").Range(Sheets("Sheet1").Cells(N, 13), Sheets("Sheet1").Cells(N, 20)).Interior.Color = Sheets("Sheet2").Cells(URNRow, 2).MergeArea(1).Interior.Color
        End If
    End If
Next N
End Sub
Sub Procedure2()
Dim N As Long
Dim URNRow As Long

For N = 2 To Sheets("Sheet1").Cells(Rows.Count, 13).End(xlUp).Row
    
    If WorksheetFunction.CountIf(Sheets("Sheet2").Range(Sheets("Sheet2").Columns(5), Sheets("Sheet2").Columns(10)), Sheets("Sheet1").Cells(N, 21)) > 0 Then
        URNRow = Sheets("Sheet2").Range(Sheets("Sheet2").Columns(5), Sheets("Sheet2").Columns(10)).Find(Sheets("Sheet1").Cells(N, 21), , xlValues, xlWhole).Row
        If Sheets("Sheet2").Cells(URNRow, 3).MergeArea(1) = Sheets("Sheet1").Cells(N, 31) Then
            Sheets("Sheet1").Range(Sheets("Sheet1").Cells(N, 21), Sheets("Sheet1").Cells(N, 28)).Interior.Color = Sheets("Sheet2").Cells(URNRow, 2).MergeArea(1).Interior.Color
        End If
    End If
Next N

End Sub
I run them both via:

Sub Colour()
Procedure1
Procedure2
End Sub
However, i was wondering if there was a way I could apply this to all of the workbooks in a particular folder? Simply to save having to do this to a large number of spreadsheets.

There are 61 spreadsheets in a folder called "GR12 Schedules" and each file is called "GR12 Schedule" and then a number i.e Schedule 1, Schedule 2 etc up to 61

Many thanks,

Chris