CODEWITHSUNDEEP
vbaexcel
Night Slasher
Night Slasher

Reputation: 3

Split Worksheets

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

Upvotes: 0

Views: 195

Answers (2)

Samuel Hulla
Samuel Hulla

Reputation: 7119

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

Upvotes: 0

Huy Pham
Huy Pham

Reputation: 493

Change your Sub to:

Sub SplitToWorksheets_step4(SheetName as String)

and in the line:

Set Fsheet = ActiveSheet

to:

Set Fsheet = Worksheets(SheetName)

Upvotes: 1

Related Questions