Forum - Φιλτράρισμα και αντιγραφή

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - Φιλτράρισμα και αντιγραφή (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/5742-filtrarisma-kai-antigrafi.html)

Φιλτράρισμα και αντιγραφή

Καλημέρα σε όλους,
εύχομαι όλοι μας και οι οικογένειές μας, να είμαστε υγιείς αυτήν την δύσκολη περίοδο.
Παίρνω το θάρρος να (ξανα)ζητήσω την βοήθειά σας, καθώς είμαι αρχάριος - πολύ αρχάριος - στην VBA, αλλά μου αρέσει πολύ και θέλω να πειραματίζομαι και να προσπαθώ.
Έχω, λοιπόν, ένα φύλλο εργασίας με 24 στήλες και 1132 σειρές με δεδομένα. Φυσικά, για να μπορώ να τα επεξεργαστώ ευκολότερα, θα πρέπει να τα φιλτράρω.
Στην αρχή σκέφτηκα τα απλά φίλτρα του Excel, αλλά έπεσα πάνω στον παρακάτω κώδικα στο internet και θέλησα να τον χρησιμοποιήσω.
Τον αντέγραψα (με τις απαραίτητες αλλαγές στα φύλλα και τα κελιά), αλλά μου βγάζει μήνυμα λάθους "Run-time error 1004".
Προσπάθησα, με τις ελάχιστες γνώσεις μου να καταλάβω που είναι το λάθος, αλλά δεν τα κατάφερα. Γι' αυτό απευθύνομαι σε εσάς, μήπως μπορέσετε να με βοηθήσετε.
Ο κώδικας είναι ο εξής:

Κώδικας:

Sub copy_filtered_data()

    

Dim count_col, count_row As Integer

Dim orig, output As Worksheet
 

ThisWorkbook.Sheets("Sheet3").Cells.ClearContents

Worksheets("Sheet1").Activate
 

Set orig = ThisWorkbook.Sheets("Sheet1")

Set output = ThisWorkbook.Sheets("Sheet3")
 

count_col = WorksheetFunction.CountA(Range("A7", Range("A7").End(xlToRight)))

count_row = WorksheetFunction.CountA(Range("A7", Range("A7").End(xlDown)))
 
 ActiveSheet.Range("A7").AutoFilter Field:=2, Criterial:=Cells(2, 1).Value
 

orig.Range(Cells(7, 1).Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible).Copy

output.Cells(1, 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False

Worksheets("Sheet1").ShowAllData

Worksheets("Sheet1").AutoFilterMode = False

Worksheets("Sheet3").Activate

ActiveSheet.Range("A1").Select
 

End Sub

Αν έχω καταλάβει σωστά το πρόβλημα είναι στην γραμμή που έχω τονίσει τα γράμματα.
Ευχαριστώ για τον χρόνο σας και συγγνώμη για το μεγάλο μήνυμα.
Ελπίζω στην βοήθειά σας.

Καλημέρα Κώστα,

Δοκίμασε τις παρακάτω αλλαγές να δεις αν έχεις τα επιθυμητά αποτελέσματα:

Τη γραμμή με τα έντονα γράμματα άλλαξέ την σε:
Range("Sheet1!A7").AutoFilter 2, ActiveSheet.Cells(2, 1).Value

και στην ακριβώς από κάτω γραμμή αντικατέστησε την κόκκινη τελεία με κόμμα:
... Range(Cells(7, 1).Cells(c ...

Καλημέρα Χρήστο, σ' ευχαριστώ για την απάντησή σου.
Δοκίμασα την πρότασή σου και τώρα μου βγάζει μήνυμα λάθους "Run time error 1004. Η μέθοδος AutoFilter της κλάσης Range απέτυχε". Το κακό είναι ότι δεν έχω τις γνώσεις για να καταλάβω τι πρέπει να ψάξω και να διορθώσω.
Γι' αυτό φυσικά απευθύνθηκα στην βοήθειά σας.

Είναι εύκολο να ανεβάσεις το αρχείο σου με δοκιμαστικά δεδομένα;

Πάντως τρέχοντας τον κώδικά σου με τις αλλαγές που σου ανέφερα τρέχει κανονικά στο δικό μου. Δηλαδή:

Κώδικας:

Sub copy_filtered_data()

    

Dim count_col, count_row As Integer

Dim orig, output As Worksheet
 

ThisWorkbook.Sheets("Sheet3").Cells.ClearContents

Worksheets("Sheet1").Activate
 

Set orig = ThisWorkbook.Sheets("Sheet1")

Set output = ThisWorkbook.Sheets("Sheet3")
 

count_col = WorksheetFunction.CountA(Range("A7", Range("A7").End(xlToRight)))

count_row = WorksheetFunction.CountA(Range("A7", Range("A7").End(xlDown)))
 

Range("Sheet1!A7").AutoFilter 2, ActiveSheet.Cells(2, 1).Value
 

orig.Range(Cells(7, 1), Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible).Copy

output.Cells(1, 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False

Worksheets("Sheet1").ShowAllData

Worksheets("Sheet1").AutoFilterMode = False

Worksheets("Sheet3").Activate

ActiveSheet.Range("A1").Select
 

End Sub

Χρήστο, ετοίμασα και ανεβάζω ένα μικρό αρχείο Excel το οποίο έχει την μορφοποίηση του κανονικού αρχείου αλλά μόνο με 5 σειρές δεδομένων.
Ελπίζω να σε βοηθήσει.

Μήπως δεν είναι θέμα του κώδικα, αλλά κάποιας ρύθμισης του ίδιου του Excel;

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

Κώστα,

Δοκίμασε το συνημμένο αρχείο να δεις αν σε βολεύει.

Χρήστο, με μια πρώτη δοκιμή φαίνεται να δουλεύει. Θα το δοκιμάσω και στο αρχείο με τα πλήρη στοιχεία και θα επανέλθω.
Πάντως σε ευχαριστώ πολύ για τον χρόνο και την προσπάθειά σου.
Να είσαι καλά.

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

Έχω τροποποιήσει το αρχείο έτσι ώστε να αλλάζεις το πεδίο αναζήτησης στο Α1.

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

Δοκίμασε το συνημμένο κι αν χρειαστείς αναζήτηση σ' αυτά τα συγκεκριμένα πεδία, το τροποποιούμε ανάλογα.

Χρήστο ειλικρινά σ' ευχαριστώ πολύ για τον κόπο και την προσπάθειά σου να με βοηθήσεις.
Ξέρω ότι σε κούρασα και με συγχωρείς.
Θα συνεχίσω τις δοκιμές με το αρχείο σου κι αν κάποια στιγμή προκύψει κάτι θα σε ξαναενοχλήσω.
Προς το παρόν καλή συνέχεια με υγεία και καλές γιορτές.