macro to sort by city...not functioning

[bluepenink]

Hi

my code is listed below:

Option Explicit
Sub FilterCities()
  'last edited March 18, 2004
    Dim myCell As Range
    Dim wks As Worksheet
    Dim DataBaseWks As Worksheet
    Dim ListRange As Range
    Dim dummyRng As Range
    Dim myDatabase As Range
    Dim TempWks As Worksheet
    Dim rsp As Integer
    Dim i As Long
    'include bottom most header row
    Const TopLeftCellOfDataBase As String = "C4"
    'what column has your key values
    Const KeyColumn As String = "A"
    'where's your data
    Set DataBaseWks = Worksheets("Main")
    i = DataBaseWks.Range(TopLeftCellOfDataBase)
    
    rsp = MsgBox("Include headings?", vbYesNo, "Headings")
    Set TempWks = Worksheets.Add
    With DataBaseWks
        Set dummyRng = .UsedRange
        Set myDatabase = .Range(TopLeftCellOfDataBase, _
                            .Cells.SpecialCells(xlCellTypeLastCell))
    End With
    'rebuild the List
    With DataBaseWks
        Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=TempWks.Range("A1"), _
            Unique:=True
        'Add the heading to the criteria area
        TempWks.Range("D1").Value = _
            .Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
    End With
    With TempWks
        Set ListRange = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
    End With
    With ListRange
        .Sort Key1:=.Cells(1), Order1:=xlAscending, _
            Header:=xlNo, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom
    End With
    'check for individual City worksheets
    For Each myCell In ListRange.Cells
        If WksExists(myCell.Value) = False Then
            Set wks = Sheets.Add
            On Error Resume Next
            wks.Name = myCell.Value
            If Err.Number <> 0 Then
                MsgBox "Please rename: " & wks.Name
                Err.Clear
            End If
            On Error GoTo 0
            wks.Move After:=Sheets(Sheets.Count)
        Else
            Set wks = Worksheets(myCell.Value)
            wks.Cells.Clear
        End If
        If rsp = 6 Then
          DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
        End If
        
        'change the criteria in the Criteria range
        TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value & Chr(34)
        'transfer data to individual City worksheets
        If rsp = 6 Then
          myDatabase.AdvancedFilter _
              Action:=xlFilterCopy, _
              CriteriaRange:=TempWks.Range("D1:D2"), _
              CopyToRange:=wks.Range("A1").Offset(i, 0), _
              Unique:=False
        Else
          myDatabase.AdvancedFilter _
              Action:=xlFilterCopy, _
              CriteriaRange:=TempWks.Range("D1:D2"), _
              CopyToRange:=wks.Range("A1"), _
              Unique:=False
        End If
    Next myCell
    Application.DisplayAlerts = False
    TempWks.Delete
    Application.DisplayAlerts = True
    MsgBox "Data has been sent"
    
End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

basically....my range of data in sheet "main" start at (C5:N)

where row 5 and 6 are headers.

this macro was being used by another individual, so i am using it however im not strong with macros at all, so wondering what is possibly going wrong.

the macro is only copying column "C" the data in it, and that is it.

basically, this macro creates worksheets by column C i.e. city name, and dumps all data that belongs to i.e. Atlanta into a new worksheet.

but its only copying data from column C, and nothing else.

also, is it possible to have the formatting get copied as well? pls HELP!