هذا الكود الستاذ ياسر خليل يفى بالغرض
Sub Test()
Dim ws As Worksheet
Dim sh As Worksheet
Dim lr As Long
Set ws = Sheets("DATA")
Set sh = Sheets("AS")
Application.ScreenUpdating = False
sh.Range("B3:U1026").ClearContents
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 2
ws.Range("B7:U1026").SpecialCells(xlCellTypeVisible).Copy
sh.Range("B" & lr).PasteSpecial xlPasteValues
On Error Resume Next
sh.Columns(5).Replace 0, ""
sh.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub