Macro Filter by PVT, Copy, Create Files

[GCLIFTON]

Getting an error on the red letters below dont know why and how to correct.


Option Explicit
Sub BankConsolidate3()
Dim fPATH As String, fNAME As String, wbCSV As Workbook
Dim LR As Long


fPATH = "C:\Users\CliftG01\Documents\Test"
fNAME = Dir(fPATH & "*.csv")


Do While Len(fNAME) > 0
LR = ActiveSheet.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set wbCSV = Workbooks.Open(fPATH & fNAME)
ActiveSheet.UsedRange.Offset(1).Copy ThisWorkbook.Sheets("Sheet1").Range("A" & LR + 1)
wbCSV.Close False


fNAME = Dir
Loop
Call Split_By_Profile_Code '<---Call the Spilt Code
End Sub






Sub Split_By_Profile_Code()
Dim wsSrc As Worksheet
Dim wbTgt As Workbook
Dim myPath As String
Dim cel As Range
Dim LR As Long
Dim LC As Long


myPath = "C:\Users\CliftG01\Documents\Done" '
If Not Evaluate("ISREF(Lists!n1)") Then
WorkSheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Lists"
Else
Sheets("Lists").Cells.Clear
End If


Set wsSrc = Sheets("Data")
With wsSrc
.Activate
.Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Lists").Range("A1"), Unique:=True
ActiveWorkbook.Names.Add Name:="Profile_Code", RefersTo:= _
"=OFFSET(Lists!$A$2,0,0,(COUNTA(Lists!$A:$A)),1)"
LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
If Not .AutoFilterMode Then
.Rows("1:1").AutoFilter
End If
For Each cel In Range("Profile_Code")
.Range(.Cells(1, "A"), .Cells(LR, LC)).AutoFilter field:=2, Criteria1:=cel.Value
.Range(.Cells(1, "A"), .Cells(LR, LC)).SpecialCells(xlCellTypeVisible).Copy


On Error Resume Next
If Not IsEmpty(cel.Value) Then
Kill (myPath & cel.Value & ".xls")
Else
Kill (myPath & "Blanks" & ".xls")
End If
On Error GoTo 0


Application.SheetsInNewWorkbook = 1
Set wbTgt = Workbooks.Add
With wbTgt
wsSrc.Range(wsSrc.Cells(1, "A"), wsSrc.Cells(LR, LC)).SpecialCells(xlCellTypeVisible).Copy
.Sheets("Sheet1").Range("A1").PasteSpecial
.Sheets("Sheet1").Columns.AutoFit
If Not cel.Value = "" Then
.SaveAs Filename:=myPath & cel.Value & ".xls", FileFormat:=xlNormal
Else
.SaveAs Filename:=myPath & "Blanks.xls", FileFormat:=xlNormal
End If
.Close False
End With
Next cel
.AutoFilterMode = False
End With
End Sub