Question

当前，此宏根据单元格拆分工作表。

它运行良好，但是我将其作为按钮放在其他页面上，但这会选择活动页面，我希望它在特定的工作表上运行此宏。

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

将您的Sub更改为：

Sub SplitToWorksheets_step4（SheetName作为字符串）

并在该行中：

设置Fsheet = ActiveSheet

收件人：

设置Fsheet = Worksheets（SheetName）

Answer 2

在其他页面上，但这选择了活动页面，我希望它运行该宏在特定工作表上。

那很简单。 Set您的Worksheet对象到特定的Sheet.Name-例如：

Dim Fsheet As Worksheet: Set Fsheet = Sheets("Your sheet name")

在更实际的用法中，例如，可以将工作表名称作为过程argument传递：

Private Sub SplitToWorksheets_step4(ByVal sheetName as String)
   Dim fsheet as Worksheet: Set fsheet = Sheets(sheetName)
   ' ... do something
End Sub

为每个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

分割工作表

2 个答案: