This macro is close to working but still running into error after the first run. I am trying to let the user select the column that contains the values that are to be split out into their own worksheet. First I am trying to identify the unique values in that column and copying them to a temporary location. Then each unique value from that column will take the entire rows for them and put them in a separate worksheet. This works great up until I come to a part where I am trying to clear the copied data and it errors out after the first run in the If WksExists(c.Value) Then Sheets(c.Value).Cells.Clear part. My intent is to also replace the piece of code where the data is copied to based on where the last empty column and first cell in that column is available as this will vary for each workbook this macro will be used for.

Here is what I have for my code so far that I am testing with:

Sub MultiSheets()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As String
Dim c As Range
Dim rs As Range
Set ws1 = Sheets(ActiveSheet.Name)
Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
Dim lastCell As String

Set rs = Application.InputBox(Prompt:="Select the Column for Lookup", Title:="Range Select", Type:=8)
 rs.Name = "Lookup"

'this will find the last column available
ActiveCell.End(xlToRight).Select
'move one cell to the right from the last used cell
ActiveCell.Offset(0, 1).Select


ActiveSheet.Columns("A").SpecialCells(xlLastCell).Select
lastCell = Split(ActiveCell.Address, "$")(1) & Split(ActiveCell.Address, "$")(2)
Set rng = Range("A1:" & lastCell)
'rng.Name = "SplitSheets"

   Range("A2").Select
'extract a list of Modality Codes
ws1.Columns("A:A").Copy _
  Destination:=Range("M1")
ws1.Columns("M:M").AdvancedFilter _
  Action:=xlFilterCopy, _
  CopyToRange:=Range("L1"), Unique:=True
r = Cells(Rows.Count, "L").End(xlUp).row
'r = lastCell = Split(ActiveCell.Address, "$")(1) & Split(ActiveCell.Address, "$")(2)

'set up Criteria Area
Range("L1").Value = Range("A1").Value

For Each c In Range("L2:L" & r)
  'add to the criteria area
  ws1.Range("M2").Value = c.Value
  'add new sheet (if required)
  'and run advanced filter
  If WksExists(c.Value) Then
    Sheets(c.Value).Cells.Clear
  rng.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=ws1.Range("M1:M2"), _
        CopyToRange:=Sheets(c.Value).Range("A1"), _
        Unique:=False
        Columns("A:K").Select
    Columns("A:K").EntireColumn.AutoFit
  'Columns.AutoFit
        
  Else
    Set wsNew = Sheets.Add
    wsNew.Move After:=Worksheets(Worksheets.Count)
    wsNew.Name = c.Value
    rng.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=ws1.Range("M1:M2"), _
        CopyToRange:=wsNew.Range("A1"), _
        Unique:=False
        Columns("A:K").Select
    Columns("A:K").EntireColumn.AutoFit
           'Columns.AutoFit
  End If
Next
ws1.Select
ws1.Columns("L:M").Delete
SortDescending = False

If ActiveWindow.SelectedSheets.Count = 1 Then
    FirstWSToSort = 1
    LastWSToSort = Worksheets.Count
Else
    With ActiveWindow.SelectedSheets
        For N = 2 To .Count
            If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                MsgBox "You cannot sort non-adjacent sheets"
                Exit Sub
            End If
        Next N
        FirstWSToSort = .Item(1).Index
        LastWSToSort = .Item(.Count).Index
     End With
End If

For M = FirstWSToSort To LastWSToSort
    For N = M To LastWSToSort
        If SortDescending = True Then
            If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
                Worksheets(N).Move Before:=Worksheets(M)
            End If
        Else
            If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
               Worksheets(N).Move Before:=Worksheets(M)
            End If
        End If
     Next N
Next M
 Range("A2").Select
 

End Sub
Function WksExists(wksName As String) As Boolean

   On Error Resume Next
   WksExists = CBool(Len(Worksheets(wksName).Name) > 0)

End Function