Help with VBA code not returning all results - Code & workbook in post

[LNG2013]

I am using the VBA code below to look at a column and separate the rows onto different sheets based on the value of the item in column C.

Unfortunately it seems to be dropping rows/ data sets in the transfer. Any help would be appreciated.

I have also included the WorkBook with the macro:
http://db.tt/i8VmsB8c

All help is appreciated

Sub DistributeArea()
Application.ScreenUpdating = False
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim i As Long
    
    Set wsAll = Worksheets("Report") ' change All to the name of the worksheet the existing data is on
    
    LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wsCrit = Worksheets.Add
    
    ' column AA has the criteria eg project ref
    wsAll.Range("C1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
    
    LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRowCrit
    
        Set wsNew = Worksheets.Add
        wsNew.Name = "Objective" & wsCrit.Range("A2")
        wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsCrit.Rows(2).Delete
        
    Next i
    
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub

 

[AlphaFrog]

Column A doesn't go all the way down to the last used row. Try using column C to determine the last used row.

LastRow = wsAll.Range("C" & Rows.Count).End(xlUp).Row

 

[LNG2013]

AlphaFrog you rock, thanks for finding the error!