Sub Macro1()
Dim RJ As Worksheet 'déclare la variable RJ (onglet Runs Journalieres)
Dim R As Worksheet 'déclare la variabel R (onglet Rapport)
Dim PL(1 To 3) As Range 'déclare le tableau TL de 3 plages de PL1 à PL3
Dim I As Byte 'déclare la variabel I (Incrémet)
Dim J As Integer 'déclare la variabel J (incrément)
Dim K As Integer 'déclare la variabel K (incrément)
Dim TL() As Variant 'déclare la variabel TL (Tableau des lignes)
Set RJ = Worksheets("Runs Journalieres") 'définit l'onglet RJ
Set R = Worksheets("Rapport ") 'définit l'onglet R
Set PL(1) = RJ.Range("B3").CurrentRegion 'définit la plage PL(1)
Set PL(2) = RJ.Range("E3").CurrentRegion 'définit la plage PL(2)
Set PL(3) = RJ.Range("H3").CurrentRegion 'définit la plage PL(3)
For J = 1 To 3 'boucle 1 : sur les 3 plages
For I = 4 To PL(J).Rows.Count 'boucle 2 sur toutes les lignes I de la plage de la boucle 1
'condition : si la cellule ligen I colonne 2 de la plage PL(J) a le fond bleu
If PL(J)(I, 2).Interior.Color = 14994616 Then
K = K + 1 'incrémente T
ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 ligne, K colonnes)
TL(1, K) = PL(J)(I, 2) 'récupère la valeur de la cellule dans la ligne 1 de Tl
TL(2, K) = "Run" & J 'récupère le numéro du Run dans la ligne 2 de TL
TL(3, K) = "?" 'tu n'as pas précisé alors j'ai mis ? dans la ligne 3 de TL (met "" si tu ne veux rien)
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 2
Next J 'prochaine plage de la boucle 1
R.Range("A3").CurrentRegion.ClearContents 'efface d'éventuelles ancienne données
R.Range("A4").Resize(K, 3).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule A4 redimensionnée de l'onglet R
End Sub
merci beaucoup c´est génialBonjour Djamal, bonjour le forum,
Attention le second onglet de ton classeur contient un espace à la fin (Rapport ). Il faut le supprimer (Rapport) pour que le code ci-dessous fonctionne. Tu n'as pas précisé ce que tu voulais dans la colonne CT ?
Le code :
VB:Sub Macro1() Dim RJ As Worksheet 'déclare la variable RJ (onglet Runs Journalieres) Dim R As Worksheet 'déclare la variabel R (onglet Rapport) Dim PL(1 To 3) As Range 'déclare le tableau TL de 3 plages de PL1 à PL3 Dim I As Byte 'déclare la variabel I (Incrémet) Dim J As Integer 'déclare la variabel J (incrément) Dim K As Integer 'déclare la variabel K (incrément) Dim TL() As Variant 'déclare la variabel TL (Tableau des lignes) Set RJ = Worksheets("Runs Journalieres") 'définit l'onglet RJ Set R = Worksheets("Rapport ") 'définit l'onglet R Set PL(1) = RJ.Range("B3").CurrentRegion 'définit la plage PL(1) Set PL(2) = RJ.Range("E3").CurrentRegion 'définit la plage PL(2) Set PL(3) = RJ.Range("H3").CurrentRegion 'définit la plage PL(3) For J = 1 To 3 'boucle 1 : sur les 3 plages For I = 4 To PL(J).Rows.Count 'boucle 2 sur toutes les lignes I de la plage de la boucle 1 'condition : si la cellule ligen I colonne 2 de la plage PL(J) a le fond bleu If PL(J)(I, 2).Interior.Color = 14994616 Then K = K + 1 'incrémente T ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 ligne, K colonnes) TL(1, K) = PL(J)(I, 2) 'récupère la valeur de la cellule dans la ligne 1 de Tl TL(2, K) = "Run" & J 'récupère le numéro du Run dans la ligne 2 de TL TL(3, K) = "?" 'tu n'as pas précisé alors j'ai mis ? dans la ligne 3 de TL (met "" si tu ne veux rien) End If 'fin de la condition Next I 'prochaine ligne de la boucle 2 Next J 'prochaine plage de la boucle 1 R.Range("A3").CurrentRegion.ClearContents 'efface d'éventuelles ancienne données R.Range("A4").Resize(K, 3).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule A4 redimensionnée de l'onglet R End Sub
Bonsoir c´est encore moimerci beaucoup c´est génial
Sub Macro1()
Dim RJ As Worksheet 'déclare la variable RJ (onglet Runs Journalieres)
Dim RD As Worksheet 'déclare la variable RD (onglet rapport de détecté>30)
Dim RB As Worksheet 'déclare la variabel RB (onglet Rapport de Biobanque)
Dim COUL1 As Long 'déclare la variable COUL1 (COULeur 1)
Dim PL(1 To 10) As Range 'déclare le tableau TL de 10 plages de PL1 à PL10
Dim I As Byte 'déclare la variabel I (Incrémet)
Dim J As Integer 'déclare la variabel J (incrément)
Dim K As Integer 'déclare la variabel K (incrément)
Dim TL() As Variant 'déclare la variabel TL (Tableau des lignes)
Set RJ = Worksheets("Runs Journalieres") 'définit l'onglet RJ
COUL1 = RJ.Range("D3").Interior.Color 'définit la couleur de référence COUL1
Set RB = Worksheets("Rapport de Biobanque") 'définit l'onglet RB
Set PL(1) = RJ.Range("B14").CurrentRegion 'définit la plage PL(1)
Set PL(2) = RJ.Range("E14").CurrentRegion 'définit la plage PL(2)
Set PL(3) = RJ.Range("H14").CurrentRegion 'définit la plage PL(3)
Set PL(4) = RJ.Range("K14").CurrentRegion 'définit la plage PL(4)
Set PL(5) = RJ.Range("N14").CurrentRegion 'définit la plage PL(5)
Set PL(6) = RJ.Range("Q14").CurrentRegion 'définit la plage PL(6)
Set PL(7) = RJ.Range("T14").CurrentRegion 'définit la plage PL(7)
Set PL(8) = RJ.Range("W14").CurrentRegion 'définit la plage PL(8)
Set PL(9) = RJ.Range("Z14").CurrentRegion 'définit la plage PL(9)
Set PL(10) = RJ.Range("AC14").CurrentRegion 'définit la plage PL(10)
For J = 1 To 10 'boucle 1 : sur les 10 plages
For I = 4 To PL(J).Rows.Count 'boucle 2 sur toutes les lignes I de la plage de la boucle 1
'condition : si la cellule ligen I colonne 2 de la plage PL(J) a le fond bleu
If PL(J)(I, 2).Interior.Color = COUL1 Then
K = K + 1 'incrémente K
ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 ligne, K colonnes)
TL(1, K) = PL(J)(I, 2) 'récupère la valeur de la cellule dans la ligne 1 de Tl
TL(2, K) = "Run" & J 'récupère le numéro du Run dans la ligne 2 de TL
TL(3, K) = "?" 'tu n'as pas précisé alors j'ai mis ? dans la ligne 3 de TL (met "" si tu ne veux rien)
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 2
Next J 'prochaine plage de la boucle 1
RB.Range("E3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles ancienne données
If K > 0 Then RB.Range("E4").Resize(K, 3).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule E4 redimensionnée de l'onglet R
End Sub