Bonjour
Bonjour à tous
Un essai à tester.
Option Explicit
Dim nf, refS, refD, refF, f As Worksheet, fs As Worksheet, tablo, tabloR()
Dim i&, j&, col&, k&, n&, nomF$
Private Sub CommandButton1_Click()
Set fs = Sheets("Synthése")
nf = Array("Autorisations et documents", "Controles Equipements", "Controles Véhicules", "Formations et Habilitations")
refS = Array(14, 9, 5, 11) 'première ligne des données des 4 feuilles
refD = Array("A9", "G9", "A25", "A49") 'première ligne des données sur la feuille de Synthèse
refF = Array("C17", "I17", "I39", "Q64") 'dernière cellule des tableaux de synthèse
For n = 0 To 3
Set f = Sheets(nf(n))
tablo = f.Range("A" & refS(n)).CurrentRegion
ReDim tabloR(1 To UBound(tablo, 1) - 1, 1 To UBound(tablo, 2))
k = 0
For i = 4 To UBound(tablo, 1)
For j = 1 To UBound(tablo, 2)
If f.Cells(refS(n) + i - 4, j).DisplayFormat.Interior.Color = RGB(255, 0, 0) _
Or f.Cells(refS(n) + i - 4, j).DisplayFormat.Interior.Color = RGB(255, 192, 0) Then
'on recopie la ligne dans tabloR
For col = 1 To UBound(tablo, 2)
tabloR(1 + k, col) = tablo(i, col)
Next col
k = k + 1
GoTo suite
End If
Next j
suite:
Next i
fs.Range(refD(n) & ":" & refF(n)).ClearContents
On Error Resume Next
fs.Range(refD(n)).Resize(k, UBound(tablo, 2)) = tabloR
Erase tabloR
Erase tablo
Next n
End Sub
Bye !