Copier la feuille Devises dans le même fichier qui sera Devises(2)
Sub CompterCellulesEnvert()
Dim PlageTest As Range, iCell As Range
With ActiveWorkbook
Set PlageTest = Range("A2:C24")
For Each iCell In PlageTest
If iCell.Interior.color = RGB(146, 208, 80) Then
CompterCellules = CompterCellules + 1
End If
Next iCell
MsgBox "Il y a " & CompterCellules & " cellules vert."
[G28].Value = CompterCellules
Wnd With
End Sub
=CountColoredCells(A2:D24;E28)
Function CountColoredCells(rng As Range, color As Range) As Long
Dim cell As Range
Dim count As Long
count = 0
For Each cell In rng
If cell.Interior.color = color.Interior.color Then
count = count + 1
End If
Next cell
CountColoredCells = count
End Function
Bonjour Nicolas, la solution ne fonctionne pas. J'ai 2 classeurs d'ouvert.Bonjour,
A la volé, sans avoir testé
VB:Sub CompterCellulesEnvert() Dim PlageTest As Range, iCell As Range With ActiveWorkbook Set PlageTest = Range("A2:C24") For Each iCell In PlageTest If iCell.Interior.color = RGB(146, 208, 80) Then CompterCellules = CompterCellules + 1 End If Next iCell MsgBox "Il y a " & CompterCellules & " cellules vert." [G28].Value = CompterCellules Wnd With End Sub
si tu mets dans n'importe quel classeur ouvert au même moment, ça devrait fonctionner avec tous les fichiers actifs (ActiveWorkbook)
A+
Nicolas
Copier la feuille Devises dans le même fichier qui sera Devises(2)
Bonjour, je sais pas du coup, ça fonctionne sur le classeur actif, mais après je sèche désolé
Je me doute, j'étais proche mais j'ai eu un bug sur les chaques fichiers (la boucle que j'arrive pas)
Merci beaucoupRe
@Anto35200
Je te propose ce fichier
1) j'ai commenté tout le code
2) La demande ne correspond pas au fichier fournit !!!
Regarde la pièce jointe 1198712
Conséquence ==> J'ai fait la macro en fonction du fichier fournit et pas en fonction du post # 17
3) Une seule macro fait tout avec le résultat demandé directement
4) J'ai fait des essais ET tu vas rire mais cela fonctionne (!!!!
==> Cela fonctionne avec le fichier fournit au post # 17 ==> Extraction du 21.05.2024.xlsx
Merci de ton retour