Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rr As Range, r As Range
    Dim ws As Worksheet
    Dim n As Long
    
    Set rr = Intersect(Target, Columns(6))
    
    If rr Is Nothing Then Exit Sub
    
    Set ws = Sheets("Records")
    n = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Application.EnableEvents = False
    For Each r In rr
        If r.Value <> "" Then
            ws.Cells(n, "B").Value = r.Value
            ws.Cells(n, "A").Value = r.Offset(, -2).Value
            ws.Cells(n, "C").Value = r.Offset(, -1).Value
            n = n + 1
            r.EntireRow.Delete
        End If
    Next
    
    Application.EnableEvents = True
    
    ws.Cells(1).CurrentRegion.Sort Key1:=ws.Columns("C"), order1:=xlAscending, Header:=xlYes
    
End Sub