Copy rows to a new workbook based on conditions

[DaBears]

Dear All,
I've just recently started using VBA and i have a question about a current macro I have been working with. I copied this off of a former thread i found on this site and it works perfect. However now i would like to change to fit another need. I have copied in the thread from prior below but what i need changed is the column sales name to column D instead of C. The other problem I have is when column C is not letters but numbers i.e.(10,20,30,etc.) it gives me an error on the Red highlighted portion below.
Below is the former Thread with the Prior Macro. Any help showing me what I need to change when sorting on another column beside "C" would be appreciated. Also when my column C changes from letters to numbers.Thanks very much for the help in advance.

I think I need a macro to help to copy rows to a new workbook on condition after sorting
A given workbook(sales.xls) inculding a worksheet of thousands of rows and 10 columns(A...J) like as following:
---------------Sample Sheet------------------
A B C(salescode) D(amt) E(qty) F .... J
1 CA 6 CK 180 8
2 CN 5 JB 69 4
3 CN 8 MJ 30 3
4 CA 5 CK 100 7

Remark: column C is the salescode like CK which is equal to Clive_KUEN
--------------------------------------------
I would like to sort data with cloumn C first and then extract columns A,B,C,D,E to a new workbook with filename as the sales name of column C.

Here is the macro below.

Sub Run_File()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Application.Run ("Add_Sheets")
Application.Run ("Find_Name_Code")

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "Done!"
End Sub


Private Sub Find_Name_Code()
Dim lastcol As Integer, x As Long
Dim lastrow As Long, lastrow2 As Long
Dim MyArr()
Dim DataRange As Range


With Sheets("Main")
Set DataRange = .UsedRange

lastrow = .Cells(65536, 3).End(xlUp).Row
lastcol = .Cells(1, 1).End(xlToRight).Column

.Columns(lastcol + 2).ClearContents
.Range("C1:C" & lastrow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Cells(1, lastcol + 2), Unique:=True
.Cells(1, lastcol + 2).Delete shift:=xlUp

lastrow2 = .Cells(65536, lastcol + 2).End(xlUp).Row
ReDim MyArr(1 To lastrow2)
For x = 1 To lastrow2
MyArr(x) = .Cells(x, lastcol + 2)
Next x
.Columns(lastcol + 2).ClearContents

For x = 1 To lastrow2
.Cells(1, 3).AutoFilter Field:=3, Criteria1:=MyArr(x)
DataRange.SpecialCells(xlCellTypeVisible).Copy Sheets(MyArr(x)).Range("A1")
Sheets(MyArr(x)).Copy
ThisWorkbook.Activate
Next x
.Cells(1, 3).AutoFilter
End With
End Sub


Private Sub Add_Sheets()
Dim lastrow As Long, sheettoname As String, x As Long
lastrow = Sheets("Main").Cells(Rows.Count, 3).End(xlUp).Row

For x = 2 To lastrow
sheettoname = Sheets("Main").Cells(x, 3)
If SheetExists(sheettoname) = True Then
' do nothing
Else
Worksheets.Add After:=Sheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = Sheets("Main").Cells(x, 3).Value
End If
Next x
Sheets("Main").Select
End Sub

Private Function NameofSheet()
NameofSheet = Application.Caller.Parent.Name
End Function

Private Function SheetExists(sheetname) As Boolean
Dim abc As Object
On Error Resume Next
Set abc = ActiveWorkbook.Sheets(sheetname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function

 

[DaBears]

Any help on this one would be greatly appreciated. If you need more info let me know.