Option Explicit
Sub Transfert()
Dim i As Long, tb, j As Integer, k As Integer, lig As Long 'déclaration des variables
With Sheets("DATA_MODELES") 'avec la feuille ... tous les range qui suivent et qui ont un point devant vont sur cette feuille
.Cells.Clear
Cells.Interior.Pattern = xlNone
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row 'boucle sur les lignes existantes
lig = .Range("A" & Rows.Count).End(xlUp).Row + 1 'dernière ligne +1
If i Mod 2 = 0 Then
.Range("A" & lig).Interior.Color = RGB(198, 224, 180)
Else
.Range("A" & lig).Interior.Color = RGB(217, 225, 242)
End If
.Range("A" & lig).Value = Range("A" & i).Value
.Range("B" & lig).Value = "[NCL]" & Range("B" & i).Value & " " & Range("D" & i).Value
.Range("C" & lig).Value = Range("C" & i).Value
.Range("E" & lig).Value = Range("E" & i).Value
lig = lig + 1
tb = Split(Range("D" & i).Value, ",") 'tableau des modèles de la ligne
For j = 0 To UBound(tb) 'boucle sur les modèles
If i Mod 2 = 0 Then
.Range("A" & lig).Interior.Color = RGB(198, 224, 180)
Else
.Range("A" & lig).Interior.Color = RGB(217, 225, 242)
End If
.Range("A" & lig).Value = Range("A" & i).Value & "-" & j + 1
.Range("B" & lig).Value = Range("B" & i).Value & " " & tb(j)
.Range("C" & lig).Value = Range("C" & i).Value
For k = 0 To UBound(tb)
.Range("D" & lig).Value = .Range("D" & lig).Value & " Modèle compatible: " & tb(k) & ", "
Next k
.Range("D" & lig).Value = Left(.Range("D" & lig).Value, WorksheetFunction.Min(125, Len(.Range("D" & lig).Value) - 2))
.Range("E" & lig).Value = Range("E" & i).Value
lig = lig + 1
Next j
Next i
End With
MsgBox ("Transfert effectué")
End Sub