下面的代码创建了一个新的工作表来过滤一些数据：

Option Explicit

Sub createsheet()

    Const COL_HA = 6 ' F on data sheet is Health Auth

    Dim sName As String, sId As String
    Dim wsNew As Worksheet, wsUser As Worksheet
    Dim wsIndex As Worksheet, wsData As Worksheet
    Dim rngName As Range, rngCopy As Range
    
    With ThisWorkbook
         Set wsUser = .Sheets("user")
         Set wsData = .Sheets("data")
         Set wsIndex = .Sheets("index")
    End With
         
    ' find row in index table for name from drop down
    sName = Left(wsUser.Range("M42").Value, 30)
    Set rngName = wsIndex.Range("L5:L32").Find(sName)
    If rngName Is Nothing Then
        MsgBox "Could not find " & sName & " on index sheet", vbCritical
    Else
        sId = rngName.Offset(, -1) ' column to left
    End If
    
    ' create sheet but check if already exists
    On Error Resume Next
    Set wsNew = Sheets(sName)
    On Error GoTo 0
    
    If wsNew Is Nothing Then
        ' ok add
        Set wsNew = Sheets.Add(after:=Sheets(Sheets.Count))
        wsNew.Name = sName
        MsgBox "The sheet has been successfully created. Wait a few seconds until Excel pastes the data from : " & wsNew.Name, vbInformation
    Else
        ' exists
        MsgBox "Sheet '" & sName & "' already exists", vbCritical, "Error"
        Exit Sub
    End If
    
    ' filter sheet and copy data
    Dim lastrow As Long, rngData As Range
    With wsData
        lastrow = .Cells(.Rows.Count, COL_HA).End(xlUp).Row
        Set rngData = .Range("A10:Z" & lastrow)
        .AutoFilterMode = False
        rngData.AutoFilter Field:=COL_HA, Criteria1:=sId
        Set rngCopy = rngData.SpecialCells(xlVisible)
        .AutoFilterMode = False
    End With
   
    ' new sheet
    With wsNew
        rngCopy.Copy .Range("A1")
        .Activate
        .Range("A1").Select
    End With
    
    MsgBox "Data for " & sId & " " & sName _
         & " copied to wsNew.name", vbInformation
   
End Sub

我需要宏能够运行多次。
在工作表存在的情况下，因为你运行了一个以上的宏，除了显示错误消息，我需要新的工作表仍然是创建的，无论是用一个替代名称或删除原来的工作表。我不知道如何做到这一点。