Change macro to work on a different sheet

There are a few ways to run a macro in another sheet from whichever sheet.

Sub Enter_Hallo()
Range("A1").Value = "Hallo."
End Sub

will put Hallo in cell A1 in the active sheet, in other words the sheet that is visible. Can be any sheet

Sub Enter_Hallo()
Sheets("Sheet2").Range("A1").Value = "Hallo."
End Sub

Will put Hallo in cell A1 in Sheet2 only. Macro can be run from any sheet.

Sub Enter_Hallo()
With Sheets("Sheet2").Range("A1")
.Value = "Hallo."    '<---- notice the period in front of Value
End With
End Sub

Will put Hallo in cell A1 in Sheet2 only. Macro can be run from any sheet.

It is often required to use the reference multiple times in one line.
For instance

Sub Try_It()
Range(Sheets("Sheet2").Cells(1, 1), Sheets("Sheet2").Cells(5, 1)).Copy Sheets("Sheet1").Range("M1")
End Sub

Following is an example from Smallman. Notice the use of ws multiple times.

Sub SortSheets() 
    Dim ws As Worksheet 
    For Each ws In Sheets 
        ws.Range("B2", ws.Range("B65536").End(xlUp)).Sort ws.[B2], 1
    Next ws 
End Sub

The following is from
http://msdn.microsoft.com/en-us/library/wc500chb.aspx
By using With...End With, you can perform a series of statements on a specified object without
specifying the name of the object multiple times. Within a With statement block, you can specify a
member of the object starting with a period, as if the With statement object preceded it.
For example, to change multiple properties on a single object, place the property assignment
statements inside the With...End With block, referring to the object only once instead of once for each
property assignment.
If your code accesses the same object in multiple statements, you gain the following benefits by using
the With statement:
You don't need to evaluate a complex expression multiple times or assign the result to a temporary
variable to refer to its members multiple times.
You make your code more readable by eliminating repetitive qualifying expressions.

Hello,

I refactored most of your code so it can be applied to different sheet. In addition to Jolivanes suggestion you should read this article on passing variables and arguments.
http://www.homeandlearn.org/passing_..._to_a_sub.html

Replace all your code with the code I provided. I was not able to test this because I am missing a sheet.

Hope this gets you on the right track.

Option Explicit

Sub MainProcedure()
    
    Dim arrSheets As Variant
    Dim i As Long
    
    'Turn extras off
    Call TurnExtrasOff
    
    ' Add the values to tje array of all the sheets needed.
    arrSheets = Array("Results Open", "Results Pleasure", "Results Junior")
    
    ' Loop through all the values of the array calling the appropriate.
    ' procedure.
    For i = LBound(arrSheets) To UBound(arrSheets)
        Call NationalStandings(arrSheets(i))
        Call SortNationalResults(arrSheets(i))
        Call BreakdownPlaces(arrSheets(i))
    Next i
    
    ' Turn extras back on
    Call TurnExtrasOn
    
End Sub


'Performs the National standings in the sheet passed as argument.
Sub NationalStandings(ByVal strSheetToAnalyze As String)

    Dim Dn As Range
    Dim temp As String
    Dim Rng As Range
    Dim Dic As Object
    Dim k As Variant
    Dim p As Variant, c As Long
    Dim Sp As Variant

    ' This part might need revision; I am not sure that this is doing. Sheet
    ' "AllStates"" is missing.
    Set Rng = Range(Sheets("AllStates").Range("H2"), Sheets("AllStates").Range("H" & Rows.Count).End(xlUp))
    
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1

    For Each Dn In Rng
        If Dn.Offset(, -2).Value = "OPEN" And Dn.Offset(, -4).Value = "Q" Then
            temp = Dn.Value & ";" & Dn.Offset(, 1) & ";" & Dn.Offset(, -1)
            If Not Dic.exists(temp) Then
                Set Dic(temp) = CreateObject("Scripting.Dictionary")
            End If

            If Not Dic(temp).exists(Dn.Offset(, -3).Value) Then
                Dic(temp).Add (Dn.Offset(, -3).Value), 1
            Else
                Dic(temp).Item(Dn.Offset(, -3).Value) = Dic(temp).Item(Dn.Offset(, -3).Value) + 1
            End If
        End If
    Next Dn

    With Sheets(strSheetToAnalyze)
        c = 2
        .Range("A1").Value = "OPEN -NATIONAL RESULTS"
        .Range("A2").Resize(, 5).Value = Array("Place", "Name", "Horse", "AOC", "CTC")
        For Each k In Dic.keys
            c = c + 1
            Sp = Split(k, ";")
            .Cells(c, "A") = Sp(2)
            .Cells(c, "B") = Sp(0)
            .Cells(c, "C") = Sp(1)
            For Each p In Dic(k)
                Select Case True
                Case p = "AOC": .Cells(c, "D") = Dic(k).Item(p)
                Case p = "CTC": .Cells(c, "E") = Dic(k).Item(p)
                End Select
            Next p
        Next k
    End With
    
End Sub


' Performs a sort in a sheet passed as arguemnt.
Sub SortNationalResults(ByVal strSheetToSort As String)

    Dim lRow As Long

    With Sheets(strSheetToSort)
        ' Determine the last row.
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Clean any previous sort fields.
        .Sort.SortFields.Clear

        ' Add the new sortfiels.
        .Sort.SortFields.Add Range("A3:A" & lRow), xlSortOnValues, xlAscending, , xlSortNormal
        .Sort.SortFields.Add Range("F3:F" & lRow), xlSortOnValues, xlDescending, , xlSortNormal
        .Sort.SortFields.Add Range("G3:G" & lRow), xlSortOnValues, xlDescending, , xlSortNormal
        .Sort.SortFields.Add Range("E3:E" & lRow), xlSortOnValues, xlDescending, , xlSortNormal
        .Sort.SortFields.Add Range("C3:C" & lRow), xlSortOnValues, xlAscending, , xlSortNormal

        ' Perform the actual sort.
        With .Sort
            .SetRange Range("A2:G" & lRow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
End Sub

' Performs a breakdown places in the sheet passed as argument.
Sub BreakdownPlaces(ByVal strSheetToWork As String)

    Dim a, i As Long, ii As Long, txt As String, AL As Object

    Set AL = CreateObject("System.Collections.ArrayList")
    
    With Sheets(strSheetToWork)
        With .Cells(1).CurrentRegion
            a = .Value
            With CreateObject("Scripting.Dictionary")
                .CompareMode = 1
                For i = 3 To UBound(a, 1)
                    If Not AL.Contains(a(i, 1)) Then AL.Add a(i, 1)
                    txt = a(i, 2) & Chr(2) & a(i, 3)
                    If Not .exists(txt) Then
                        Set .Item(txt) = CreateObject("Scripting.Dictionary")
                    End If
                    .Item(txt)(a(i, 1)) = VBA.Array(a(i, 4), a(i, 5))
                Next
                ReDim a(1 To .Count + 2, 1 To AL.Count * 2 + 2): AL.Sort
                a(2, 1) = "Name": a(2, 2) = "Horse"
                For i = 0 To AL.Count - 1
                    a(1, (i + 1) * 2 + 1) = AL(i)
                    a(2, (i + 1) * 2 + 1) = "AOC"
                    a(2, (i + 1) * 2 + 2) = "CTC"
                Next
                For i = 0 To .Count - 1
                    a(i + 3, 1) = Split(.keys()(i), Chr(2))(0)
                    a(i + 3, 2) = Split(.keys()(i), Chr(2))(1)
                    For ii = 3 To UBound(a, 2) Step 2
                        If .items()(i).exists(a(1, ii)) Then
                            a(i + 3, ii) = .items()(i)(a(1, ii))(0)
                            a(i + 3, ii + 1) = .items()(i)(a(1, ii))(1)
                        End If
                    Next
                Next
            End With
            
            With .Offset(, .Columns.Count + 1).Resize(UBound(a, 1), UBound(a, 2))
                .CurrentRegion.ClearContents
                .Value = a
                .Columns("A:B").AutoFit
            End With
        End With
    End With
End Sub

' Turns extra features off to make code run faster.
Sub TurnExtrasOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub

' Turn extra features on.
Sub TurnExtrasOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Wow! Thanks for all the help guys!