![]()
Sub Macro1() Dim rng As Range Dim lastrow As Long Worksheets("Sheet1").UsedRange.Copy With Worksheets("Sheet3") .Range("A1").PasteSpecial Paste:=xlPasteFormulas .Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row Set rng = .Range("J1").Resize(lastrow) rng.AutoFilter Field:=1, Criteria1:="=" Set rng = .Range("J2").Resize(lastrow - 1) On Error Resume Next Set rng = rng.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete .Range("J1").AutoFilter End With End Sub
Bookmarks