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