Option Explicit
Option Base 1
Option Compare Text
Dim maPlage As Range, Cel As Range, CelluleStart As Range
Dim tabl(), tablSplit() As String
Dim Ws As Worksheet
Dim i As Integer, h As Integer, m As Integer
Dim Chaine As String
Sub Récupération()
'Feuille où doit être exécutée la macro
Application.ScreenUpdating = False
'Ensemble des feuilles où doit être exécutée la macro, séparés par un ";"
Chaine = "Feuil1;Feuil2;Feuil3"
tablSplit = Split(Chaine, ";")
For m = LBound(tablSplit()) To UBound(tablSplit())
Set Ws = ThisWorkbook.Sheets(tablSplit(m))
'Plage où doit être exécutée la macro
Set maPlage = Ws.Range("B2:K5")
'Cellule de départ de réception des données
Set CelluleStart = Ws.Range("D11")
ReDim tabl(maPlage.Columns.Count * maPlage.Rows.Count, 1)
For Each Cel In maPlage
If IsNumeric(Cel.Value) = True Then
For i = LBound(tabl(), 2) To UBound(tabl(), 2)
If tabl(1, i) = Cel.Font.Color Then
For h = 2 To UBound(tabl())
If tabl(h, i) = "" Then
tabl(h, i) = Cel.Value
GoTo Borne
End If
Next h
End If
Next i
If tabl(1, 1) <> "" Then ReDim Preserve tabl(UBound(tabl()), UBound(tabl(), 2) + 1)
tabl(1, UBound(tabl(), 2)) = Cel.Font.Color
tabl(2, UBound(tabl(), 2)) = Cel.Value
End If
Borne:
Next Cel
For i = LBound(tabl(), 2) To UBound(tabl(), 2)
For h = 2 To UBound(tabl())
If tabl(h, i) = "" Then Exit For
'CelluleStart est la cellule de départ que tu peux définir plus haut (Set CelluleStart = Ws.Range("D11") )
'Le * 3 correspond aux nombres de colonnes de décalage entre deux colonnes. Ici si tu commences à D, ça ferait D ==> G ==> J ==> M ...
CelluleStart.Offset(h - 2, (i - 1) * 3).Value = tabl(h, i)
CelluleStart.Offset(h - 2, (i - 1) * 3).Font.Color = tabl(1, i)
Next h
Next i
Next m
Application.ScreenUpdating = False
End Sub
,
