Option Explicit
Dim Tabtemp As Variant
Dim TabRecup() As Variant
Dim DerLigne As Integer, Ligne%, x%
Dim Col As Byte, It As Byte, Col_cible As Byte
Dim MyArray() As Variant
Sub Transfert()
x = -1
[COLOR=blue]With ActiveSheet[/COLOR]
DerLigne = .Range("A65536").End(xlUp).Row [COLOR=green]'on détermine la derniere ligne du tableau[/COLOR]
Tabtemp = .Range(.Cells(3, 1), .Cells(DerLigne, 8)) [COLOR=green]'on charge le tableau dans un tableau temporaire[/COLOR]
MyArray = Array("R/", "A/", "M/") [COLOR=green] 'on définit un Tableau avec les choses à rechercher[/COLOR]
Col_cible = 30 [COLOR=green] 'référence de la colonne ou on va commencer à coller les données[/COLOR]
For It = 0 To UBound(MyArray)
For Ligne = 2 To UBound(Tabtemp, 1)
For Col = 3 To 8 Step 2
If Left(Tabtemp(Ligne, Col), 2) = MyArray(It) Then
DerLigne = .Cells(6000, Col_cible).End(xlUp).Row + 1
.Cells(DerLigne, Col_cible) = Tabtemp(Ligne, Col)
.Cells(DerLigne, Col_cible + 1) = Tabtemp(Ligne, 4)
.Cells(DerLigne, Col_cible + 2) = Tabtemp(Ligne, 1)
End If
Next
Next
Col_cible = Col_cible + 3
Next It
End With
Erase Tabtemp [COLOR=green]'pour libérer l'espace[/COLOR]
End Sub