Public Sub Reorganise()
Dim lastrow As Long
Dim nextrow As Long
Dim targetrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        .Range("A1:C1").Copy .Range("G1")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:C1").Resize(lastrow).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                                             Key2:=.Range("C1"), Order2:=xlAscending, _
                                             Header:=xlYes
        nextrow = 2
        targetrow = 2
        For i = 3 To lastrow + 1
        
            If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
            
                If .Cells(i, "C").Value > .Cells(targetrow, "C").Value Then
                
                    targetrow = i
                End If
            Else
            
                .Cells(targetrow, "A").Resize(, 3).Copy .Cells(nextrow, "G")
                nextrow = nextrow + 1
                targetrow = i
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub