[VBA] COPY IF

[othonas]

Καλημέρα σε όλους . Έστω ότι σε πολλά φύλλα (τα οποία είναι ονόματα υπαλλήλων ) υπάρχουν στο κελί Α1 το όνομα και Β1:Β10 διάφορα ποσά . θα ήθελα να αντιγράψω με VBA σε ένα νέο φύλλο από κάθε φύλλο τα εξής : εάν στην Β τα ποσά είναι μεγαλύτερα του μηδέν τότε στη στήλη Α τα ονόματα και στην Β τα ποσά , αλλιώς να μην αντιγράφει τίποτα . π.χ.
εάν στο φύλλο ΓΙΑΝΝΗΣ
το Β2 είναι 10,00
το Β3 είναι 0
το Β4 είναι 5,00
και στο φύλλο ΝΙΚΟΣ
το Β2 είναι 0,00
το Β3 είναι 50,00
το Β4 είναι 25,00
τότε στο φύλλο ΜΗΝΑΣ
α) στο κελί Α1 να μεταφέρει το Β2 του ΓΙΑΝΝΗ και όχι του ΝΙΚΟΥ το Β2 που είναι μηδέν ,
β) στο κελί Β1 να μεταφέρει το Β3 του ΝΙΚΟΥ και όχι το Β3 του ΓΙΑΝΝΗ που είναι μηδέν ,
γ) στο κελί c1 να μεταφέρει το Β4 του ΓΙΑΝΝΗ και στο c2 το Β4 του ΝΙΚΟΥ .

[Spirosgr]

'Οθωνα
Η συνθήκη copy if είναι σαφέστατη
ότι δεν είναι μηδενικό αντιγράφεται
Αλλά νομίζω πρέπει να διευκρινιστεί και το paste where
δηλαδή που το επικολλά και με τι κριτήριο
παράδειγμα
α) στο κελί Α1 να μεταφέρει το Β2 του ΓΙΑΝΝΗ και όχι του ΝΙΚΟΥ το Β2 που είναι μηδέν ,
Αν είναι και τα δύο μηδέν ?
β) στο κελί Β1 να μεταφέρει το Β3 του ΝΙΚΟΥ και όχι το Β3 του ΓΙΑΝΝΗ που είναι μηδέν ,
θα πάρει από εδώ και θα το βάλει σε ότι βρει κενό χύμα...?
ή πρέπει να επιλέξει στήλη ανάλογα με τις εγγραφές του φύλλου ΜΗΝΑΣ
Ανέβασε κάποιο παράδειγμα όπως είναι το "καλό" σου βιβλίο

[othonas]

ευχαριστώ για την απαντηση . Τελικά αργά χθές το βράδυ το βρήκα.

[Tasos]

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

Ευχαριστώ.

Με εκτίμηση
Τάσος

[othonas]

Ορθα Τασο εχεις δικιο και συγνωμη.
Εστω οτι εχουμε χ φυλλα απο τα οποια θα αντιγραψουμε τα κελια B12:f12 εαν ομως το κελι Β12>0.
ετσι :

If Sheets(x).Range("B12") > 0 Then
ActiveWorkbook.Sheets(x).Range("C2").Copy
Worksheets("Φύλλο1").Range("A" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Sheets(x).Range("B12:f12").Copy
Worksheets("Φύλλο1").Range("B" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

[Spirosgr]

Καλησπέρα
Για τους φίλους που παρακολουθούν το θέμα αυτό να πω το εξής:
Ο κώδικας που προτείνεται δεν αντιστοιχεί 100% στο αρχικό ζητούμενο
Για να δουλέψει όμως ακόμα και σε αυτήν την μορφή πρέπει:
1. να οριστεί ο x ως μεταβλητή ακέραιος ... Dim x as Integer
2. να ορίσουμε τα όρια του x από - έως ... For x = 1 to Sheets.Count
3. πριν την ολοκλήρωση (End sub) να μπει ένα Next x
και βέβαια πιθανόν με το όλο στήσιμο το οποίο
δεν γνωρίζουμε να χρειάζονται κάποιοι έλεγχοι...

[Tasos]

Γεια σας!

Όθωνα, Σπύρο σας ευχαριστώ για τη συμμετοχή σας!

Πάμε για άλλα!

Τάσος