Sub test() Dim x1 As String, x2, r As Range Dim dtemax As Double, j As Integer, k As Integer With Worksheets("trouble report") x1 = .Range("C8") x2 = .Range("c9") End With With Worksheets("archives") Set r = .Range("A1").CurrentRegion r.AutoFilter field:=4, Criteria1:=x1, field:=2, Criteria1:=x2 r.Cells.SpecialCells(xlCellTypeVisible).Copy End With With Worksheets("data") .Range("A50").PasteSpecial End With Worksheets("archives").AutoFilterMode = False With Worksheets("data") j = .Range("F50").End(xlDown).Row dtemax = WorksheetFunction.Max(Range(.Range("F50"), .Cells(j, "F"))) For k = j To 51 Step -1 If .Cells(k, "F") <> dtemax Then Range(.Cells(k, 1), .Cells(k, Columns.Count).End(xlToLeft)).Clear Next k End With End Sub
Sub undo() Dim j As Integer, k As Integer With Worksheets("data") j = .Range("A50").End(xlDown).Row Range(.Cells(j, "A"), .Cells(j, "A").End(xlToRight).End(xlUp)).Offset(1, 0).Clear End With End Sub
DON'T MISS