Sub DataTransfer() Application.ScreenUpdating = False With ActiveSheet .AutoFilterMode = False With Range("F1", Range("F" & Rows.Count).End(xlUp)) .AutoFilter 1, 1 If Range("F" & Rows.Count).End(xlUp).Row > 1 Then .Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2) '.Offset(1).EntireRow.Delete End If End With ActiveSheet.[F1].AutoFilter End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
DON'T MISS