Modification macro pour utiliser couleur et nom comme critere
Bonjour tout le monde,
J'ai une macro qui transfere des donnees d'une feuille a une autre .
Sur la feuille1 il y a des references (certaines sont identiques) auquelles correspondent une valeur. Pour toutes les references identique (EX :12345) il y a une ligne supplementaire (avec la meme reference, donc 12345) dans laquelle je calcule la somme des valeurs correspondant (ici la somme des veleurs affectees a la reference 12345). Cette ligne se distingue des autres par sa couleur.
J'aimerais donc transferer le resultat de la ligne en couleur sur une autre feuille (feuille2) qui elle contient deja les noms des references de couleur.
Il faut donc que je fasse une recherche par le nom et par la couleur pour ne renvoyer qu un seul resultat a la fois.
Voici le code qui fonctionne avec la recherche par nom, mais je ne sais pas bien ou inserer le critere de couleur.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| Sub Transfertresultat()
Dim Datenbasis As Worksheet
Dim Tabelle1 As Worksheet
Dim c As Range
Dim D As Range
Set Datenbasis = Worksheets("Datenbasis IST-Stunden")
Set Tabelle1 = Worksheets("Tabelle1")
For Each c In Tabelle1.Range("C3:C" & Tabelle1.Cells(Rows.Count, 3).End(xlUp).Row)
With Datenbasis.Range("F2:F" & Datenbasis.Cells(Rows.Count, 6).End(xlUp).Row)
Set D = .Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not D Is Nothing Then
Tabelle1.Range(c.Address).Offset(0, 11) = Datenbasis.Range(D.Address).Offset(0, 2)
End If
End With
Next
Set Datenbasis = Nothing
Set Tabelle1 = Nothing
MsgBox "Makro 2 wurde erfolgreich ausgeführt"
End Sub |
