Hoping I can get help fixing my code for this error. Thank you!
-----
Sub ML_ExtractKLToSheetsLastName()
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim rData As Range
Dim rfl As Range
Dim KL_LastName As String
Set ws = ActiveSheet
With ws
Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 86).End(xlUp))
.Columns(.Columns.Count).Clear
.Range(.Cells(2, 21), .Cells(.Rows.Count, 21).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
KL_LastName = rfl.Value
If WksExists(KL_LastName) Then
Sheets(KL_LastName).Cells.Clear
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = KL_LastName 'this is where the code fails'
End If
rData.AutoFilter Field:=21, Criteria1:=KL_LastName
rData.Copy Destination:=Worksheets(KL_LastName).Cells(1, 1)
ActiveSheet.Cells.Columns.AutoFit
'ActiveSheet.Range("G2").Select
'ActiveWindow.FreezePanes = True
'ActiveSheet.Columns("S:U").Select
'Selection.Columns.Group
'Range("G2").Select
'ActiveSheet.Outline.ShowLevels ColumnLevels:=1 ' to collapse the columns
Next rfl
End With
ws.Columns(Columns.Count).ClearContents
rData.AutoFilter
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
Bookmarks