[Tasos]

Καλημέρα Βασίλη και καλωσόρισες στο φόρουμ!

Αντιστοίχισε τον παρακάτω κώδικα σε ένα κουμπί και δοκίμασε:

Option Explicit

Sub CopyNonZeros()
    Dim rng As Range, Calc As Long
    With Application
        Calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        With Range("A1:E" & Range("E" & Rows.Count).End(xlUp).Row)
            .AutoFilter Field:=5, Criteria1:="<>0", Operator:=xlAnd
        End With
        Set rng = Sheet1.AutoFilter.Range
        rng.Copy
        Sheet2.UsedRange.Delete    'Sheet2 = το κωδικό όνομα του φύλλου (όπως φαίνεται στον VBE)
        With Sheet2.Range("A1")    ' όπου γίνεται η επικόλληση. Ίσως χρειαστεί προσαρμογή
            .PasteSpecial xlPasteAll
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteValues
        End With
        ActiveSheet.AutoFilterMode = False
        .CutCopyMode = False
        .Calculation = Calc
        Sheet2.Activate
        .ScreenUpdating = True
    End With
End Sub

Προσοχή! Το όνομα Sheet2 στον κώδικα ίσως χρειαστεί να προσαρμοστεί σύμφωνα με το
όνομα του νέου φύλλου που θα δημιουργήσεις (για μια και μοναδική φορά).

Το κωδικό όνομα του νέου φύλλου φαίνεται στην εικόνα παρακάτω:

Καλή συνέχεια!

Φιλικά

Τάσος