[bilakos26]

Καλησπέρα σας! Στο αρχείο που σας παρέχω θέλω από το φύλλο εργασίας ΑΝΑΦΟΡΑ, τα ΠΟΣΑ ΔΑΠΑΝΗΣ που θα μετακινούνται στο ΑΡΧΕΙΟ, να μετακινούνται με ένα συγκεκριμένο χρώμα ανάλογα με την τιμή που έχει το κελί π.χ αν το κελί έχει τιμή μεγαλύτερη των 10€, η τιμή που θα μεταφερθεί στο στο κελί του ΑΡΧΕΙΟΥ να έχει χρώμα κόκκινο.
Ο κώδικας που έχω γράψει με VBA μέχρι στιγμής, αλλάζει τα χρώματα που θέλω, αλλά κάθε φορά γίνεται όλο και πιο αργός διότι κάνει αναζήτηση των τιμών στο ΑΡΧΕΙΟ για τις τιμές που του έχω ορίσει να αλλάζει χρώμα. Στον κώδικα τις τιμές αυτές, τις ορίζω στο 'GEMISMA XROMATOS
Αυτό όμως που θέλω εγώ, είναι το χρώμα του κελιού στο οποίο θα μεταφερθεί η τιμή να αλλάζει την στιγμή που θα μεταφερθεί η τιμή, έτσι ώστε να γίνονται οι συγκρίσεις εκείνη την στιγμή.

Προς το παρών οι τιμές από το φύλλο ΑΝΑΦΟΡΑ, μεταφέρονται στο ΑΡΧΕΙΟ με αυτόν τον κώδικα:

'METAKINHSH SE ARXEIO
k = 4
Do While Worksheets("ΑΝΑΦΟΡΑ").Cells(k, 1) <> ""
  k = k + 1
Loop
k = k - 1

l = 2
Do While Worksheets("ΑΡΧΕΙΟ").Cells(l, 1) <> ""
  l = l + 1
Loop

For j = 9 To k
    Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 1) = Worksheets("ΑΝΑΦΟΡΑ").Cells(4, 2) 'ημερα
    Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 2) = Worksheets("ΑΝΑΦΟΡΑ").Cells(5, 2) 'ΜΗΝΑΣ
    Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 3) = Worksheets("ΑΝΑΦΟΡΑ.Cells(6, 2) 'ΗΜ/ΝΙΑ
    Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 4) = Worksheets("ΑΝΑΦΟΡΑ").Cells(7, 2) 'ΩΡΑ
    Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 5) = Worksheets("ΑΝΑΦΟΡΑ").Cells(8, 2) 'ΕΙΔΟΣ ΔΑΠΑΝΗΣ
    Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6) = Worksheets("ΑΝΑΦΟΡΑ").Cells(9, 2) 'ΠΟΣΟ ΔΑΠΑΝΗΣ

Next j

Σε αυτό το σημείο προσπάθησα να βάλω τον κώδικα που θα παραθέσω παρακάτω, έτσι ώστε να μου γίνεται απευθείας η αλλαγή χρώματος αλλά ο κώδικας έβγαζε error :

 

    If Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6) >= 10 Then Cell.Interior.ColorIndex = 3
    ElseIf Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6) < 10 Then Cell.Interior.ColorIndex = 0
    ElseIf Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6) <= 9.99 Then Cell.Interior.ColorIndex = 14
    ElseIf Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6) <= 7 Then Cell.Interior.ColorIndex = 4
    ElseIf Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6) < 4 Then Cell.Interior.ColorIndex = 0
    ElseIf Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6) <= 4 Then Cell.Interior.ColorIndex = 45
    End If

Μπορείτε να με βοηθήσετε με το πρόβλημά μου;