For Loop Issue

I have the following code:

    'go back to crmtasks and copy second page
    Windows("CRMTasks" & Format(Date, "ddmmyyyy") & ".xls").Activate
  For i = 2 To 20
    If WksExists("DataImport" & i) Then
    Sheets("DataImport" & i).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="10000007"
    Cells.Select
    Selection.Copy
    
    'go to new workbook and paste
    Windows("SOSCRMTasks" & Format(Date, "ddmmyyyy") & ".xls").Activate
    If Not WksExists("Sheet" & i) Then
    Sheets.Add.Name = ("Sheet" & i)
 End If
    Sheets("Sheet" & i).Select
    ActiveSheet.Paste
        Rows("1:1").Select
    Application.Run "PERSONAL.XLS!XcessSpaces"
       If Dir(SOSPath) <> "" Then
   Call ExporttoAccessSOS
   End If
End If
 Next i

The WksExists Function:

Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

The code works fine but it only works for Sheet1 & DataImport2 but not DataImport3.

Hence why the loop does not copy the relavent data from the DataImport3 page onto a "Sheet3" in SOSCRMTasks.xls

I am working on an old file at the moment, but in reality the file is more than four pages now . e.g Sheet1, DataImport2, DataImport3, DataImport4 ....

thank You