Απόκρυψη κενών κελιών στο excel με Μακροεντολή

[Payne83]

Καλησπέρα

 

Στις 2 εικόνες που επισυνάπτω θέλω να εξαφανίζω αυτόματα κάθε φορά τα κενά κελιά που εμφανίζονται στο φύλλο 2 χωρίς να χρησιμοποιώ φίλτρο, αλλά με μία μακροεντολή που θα τρέχει όταν θα πατάω σε αυτό το φύλλο.

 

Στην ουσία στο φύλλο 1 έχω ένα παράδειγμα παραγγελιάς. Οτιδήποτε είναι πάνω από 1 στην στήλη amount (θα καταλάβετε) θα εμφανίζεται στο φύλλο 2. Κάθε φορά που αλλάζω τα νούμερα και εμφανίζονται τα περιεχόμενα στο φύλλο 2 πρέπει να πατάω το φίλτρο για να μην εμφανίζονται τα κενά κελιά.

 

Εάν μπορείτε να γράψετε ένα κώδικα που να τρέχει από πίσω και να το κάνει αυτόματα θα μου ήταν χρήσιμο

 

Ευχαριστώ

 

[javavall]

Υπάρχει ένα παράδειγμα μακροεντολής στην 4η μέθοδο: http://www.exceltrick.com/how_to/delete-blank-rows-in-excel/

 

Κάτι αντίστοιχο και εδώ: http://www.extendoffice.com/documents/excel/525-excel-remove-blank-rows.html

 

Για πόσα αρχεία μιλάμε?

[australis]

Στο φυλλο που σε ενδιαφερει βαλε αυτό το κωδικα

 

(και φυσικα αντικαθιστάς τα 'sheet1" & "sheet2" με τα πραγματικα ονοματα)

 

Τι κανει ο κωδικας:

 

Βρισκει την τελευταια γραμμη στο sheet1

Διαγραφει τα περιεχομενα του sheet2

Αντιγραφει τα περιεχομενα του sheet1 στο sheet2 

Ακυρωνει την αποκρυψη γραμμων (από προηγούμενες αποκρυψεις)

Οπου βρει τη τιμη 0 (ή κενο) αποκρυπτει τη γραμμη

Private Sub Worksheet_Activate()
    
    
    Application.ScreenUpdating = False
    With Worksheets("sheet1")
        On Error Resume Next
        lastrow = .Cells.Find("*", .Cells(1), xlFormulas, xlWhole, xlByRows, xlPrevious).Row
        If Err <> 0 Then lastrow = 0
    End With
    If lastrow < 2 Then Exit Sub
    
    
    lrow = Trim(CStr(lastrow))
    Sheets("Sheet2").Cells.ClearContents
    ContentsRange = "A1:E" + lrow
    Sheets("Sheet2").Range(ContentsRange).Value = Sheets("Sheet1").Range(ContentsRange).Value
    Rows("1:" + lrow).EntireRow.Hidden = False
    For i = 2 To lastrow
        If Cells(i, 3) = 0 Then Rows(Trim(CStr(i)) + ":" + Trim(CStr(i))).EntireRow.Hidden = True
    Next i
    Application.ScreenUpdating = True
End Sub