[Συναρτήσεις] αυτόματη κατάργηση διπλότυπων

[mantarinia]

Καλή σας μέρα,
Χρειάζομαι μια μικρή βοήθεια.
Επιθυμώ να φέρω μοναδικές εγγραφές από διαφορετικά φύλλα
σε ένα συγκεντρωτικό.
Μέχρι τώρα έκανα τα εξής.

1. Αντιγραφή από όλα τα φύλλα
2. Επικόλληση στο κεντρικό
3. Ταξινόμηση
4. Κατάργηση διπλότυπων.

Δεν ξέρω την συνάρτηση που θα τα φέρνει όλα
στο συγκεντωτικό φυλλό, χωρίς τις διπλοεγγραφές.
Επισυνάπτεται δείγμα.

Ευχαριστώ.

[Spirosgr]

Αντιγράφουμε τον πιο κάτω κώδικα, σε μια module.
Συνδέουμε τον κώδικα, σε ένα κουμπί ή τον «τρέχουμε» με όποια άλλη μέθοδο θέλουμε.

Sub Combine()
    Dim sh As Worksheet _
      , Lrow As Long, Nrow As Long _
      , Rng As Range, tRng As Range _
      , i As Long

    Application.ScreenUpdating = False

    Lrow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
    Set Rng = Sheet1.Range("b7:b" & Lrow)

    If Lrow = 6 Then GoTo cnt_Here:

    Rng.ClearContents

cnt_Here:
    For i = 2 To ThisWorkbook.Sheets.Count
        Lrow = 0
        Nrow = 0
        Lrow = Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row
        Nrow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1
        Sheets(i).Range("b7:b" & Lrow).Copy _
                Destination:=Sheet1.Cells(Nrow, 2)
    Next i

    Lrow = 0
    Lrow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
    Set tRng = Sheet1.Range("b7:b" & Lrow)

    tRng.RemoveDuplicates Columns:=1, Header:=xlYes
    
    Sheet1.Sort.SortFields.Clear
    Sheet1.Sort.SortFields.Add Key:=tRng, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheet1.Sort
        .SetRange tRng
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Σημειώσεις:
Ο κώδικας, μεταφέρει τις εγγραφές από όλα τα (ν) φύλλα του βιβλίου, στο Total.

Κατόπιν, διαγράφει τα διπλότυπα και ταξiνομεί Α-Ω ή Α-Ζ

Το φύλλο Total, θα πρέπει να παραμείνει με κωδικό όνομα = Sheet1 και
πάντα στην πρώτη θέση του βιβλίου.

Οι εγγραφές στα φύλλα, θα πρέπει να είναι στην μορφή και διάταξη
του παραδειγματικού βιβλίου.

Το βιβλίο, θα πρέπει να αποθηκευτεί, ως .xlsm

[kapetang]

Καλησπέρα

Αντώνη δες μια υλοποίηση, με κώδικα VBA, στο συνημμένο.

[Spirosgr]

Γιώργο, ο κώδικάς σου, έχει ένα σφάλμα.

Ξεκινώντας θα πρέπει να καθαρίζει την περιοχή στο Total, διότι αν
για παράδειγμα έχουμε 100 εγγραφές και μετά την ανανέωση έχουμε 90
θα παραμείνουν 10 εγγραφές που δεν πρέπει...

[mantarinia]

Ευχαριστώ πολύ για άλλη μια φορά για την βοήθεια.

[kapetang]

Σπύρο δεν υπάρχει λάθος.

Οι εγγραφές που θα καταλήξουν στο φύλλο "Total" είναι i.

Πριν από την αντιγραφή τους καθαρίζονται i+5, γραμμές.

Έτσι ανάμεσα στα νέα δεδομένα και στα τυχόν παλιά θα υπάρχουν, για διάκριση, 5 κενές γραμμές.

[Spirosgr]

Γράψε στο φύλλο 100, κάτω από το Belarus πχ Hellas και από κάτω ότι να ναι πχ ΧΧΧΧ
Εκτέλεσε τον κώδικα.
Σβήσε τα πιο πάνω από το φύλλο 100 και εκτέλεσε πάλι...

[kapetang]

Σπύρο έχεις δίκιο, αλλά το λάθος είναι ότι στον κώδικα αντί:

rng.Resize(i + 5).ClearContents, από αβλεψία έγγραψα:

rng.Resize(i + 5).ClearComments

[Spirosgr]

Ok, όλα καλά!