Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Columns("F:F")) Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub If IsDate(Target) Then Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2) Target.EntireRow.Delete End If End Sub
Sheet2.Range("A2", Sheet2.Range("L" & Sheet2.Rows.Count).End(xlUp)).Sort Sheet2.[K2], 1
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Columns("K:K")) Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub If IsDate(Target) Then Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2) Sheet2.Range("A2", Sheet2.Range("M" & Sheet2.Rows.Count).End(xlUp)).Sort Sheet2.[D2], 1 End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Columns("K:K")) Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub Application.ScreenUpdating = False If IsDate(Target) Then Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2) Sheet2.Range("A2", Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp)).EntireRow.Sort Sheet2.[D2], 1 Sheet2.Columns.WrapText = False Sheet2.Columns.AutoFit End If Application.ScreenUpdating = True End Sub
DON'T MISS