Split Worksheets - vba

Question

Currently this macro splits worksheets based on a cell.
It works well, however I am putting it as a button on a different page but this selects the active page, I want it to run this macro on a specific sheet.
Sub SplitToWorksheets_step4()
'Splits the workbook into different tabs
Dim ColHead As String
Dim ColHeadCell As Range
Dim icol As Integer
Dim iRow As Long 'row index on Fan Data sheet
Dim Lrow As Integer 'row index on individual destination sheet
Dim Dsheet As Worksheet 'destination worksheet
Dim Fsheet As Worksheet 'fan data worksheet (assumed active)
Again:
'ColHead = Worksheets("Diversion Report") 'this ask the user to enter a colunm name
ColHead = InputBox("Enter Column Heading", "Identify Column", [c1].Value) 'this ask the user to enter a colunm name
If ColHead = "" Then Exit Sub
Set ColHeadCell = Rows(1).Find(ColHead, LookAt:=xlWhole)
If ColHeadCell Is Nothing Then
MsgBox "Heading not found in row 1"
GoTo Again
End If
Set Fsheet = ActiveSheet
icol = ColHeadCell.Column
'loop through values in selected column
For iRow = 2 To Fsheet.Cells(65536, icol).End(xlUp).Row
If Not SheetExists(CStr(Fsheet.Cells(iRow, icol).Value)) Then
Set Dsheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Dsheet.Name = CStr(Fsheet.Cells(iRow, icol).Value)
Fsheet.Rows(1).Copy Destination:=Dsheet.Rows(1)
Else
Set Dsheet = Worksheets(CStr(Fsheet.Cells(iRow, icol).Value))
End If
Lrow = Dsheet.Cells(65536, icol).End(xlUp).Row
Fsheet.Rows(iRow).Copy Destination:=Dsheet.Rows(Lrow + 1)
Next iRow
End Sub
Function SheetExists(SheetId As Variant) As Boolean
' This function checks whether a sheet (can be a worksheet,
' chart sheet, dialog sheet, etc.) exists, and returns
' True if it exists, False otherwise. SheetId can be either
' a sheet name string or an integer number. For example:
' If SheetExists(3) Then Sheets(3).Delete
' deletes the third worksheet in the workbook, if it exists.
' Similarly,
' If SheetExists("Annual Budget") Then Sheets("Annual Budget").Delete
' deletes the sheet named "Annual Budget", if it exists.
Dim sh As Object
On Error GoTo NoSuch
Set sh = Sheets(SheetId)
SheetExists = True
Exit Function
NoSuch:
If Err = 9 Then SheetExists = False Else Stop
End Function

Answer 1

Change your Sub to:
Sub SplitToWorksheets_step4(SheetName as String)
and in the line:
Set Fsheet = ActiveSheet
to:
Set Fsheet = Worksheets(SheetName)

Answer 2

on a different page but this selects the active page, I want it to run
this macro on a specific sheet.
Well that is simple enough.
Set your Worksheet Object to a specific Sheet.Name - eg:
Dim Fsheet As Worksheet: Set Fsheet = Sheets("Your sheet name")
In a more practical usage, you could for example pass the sheet name as a procedure argument:
Private Sub SplitToWorksheets_step4(ByVal sheetName as String)
Dim fsheet as Worksheet: Set fsheet = Sheets(sheetName)
' ... do something
End Sub
Last but not least a practical way to apply a macro for every Worksheet:
Private Sub for_every_ws()
Dim ws as Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Range("A1") = "I was here!" ' i.e.
Next ws
End Sub