Extraction avec convergence

[Bulis]

Bonjour le Forum

J'ai besoins d'un sérieux coup de main.

Il est tôt et je bloque sur un transfert de données d'un classeur à un autre classeur via un tableau de convergence

Le but est de transférer automatiquement des données d'un classeur vers un autre et de cmettre les données dans les bonne casses.

1) le classeur toto.xls avec les données connues BLEU & ROUGE et 2 autres que nous allons passer par le tableaux de convergence dans le classeur titi.xls, donc VPMC qui devient BLEU et BCS qui devient ROUGE.
2) J'ai écrit un macro qui me semblait bien , mais elle ne fonctionne pas car elle ne ramène pas les données dans le tableau titi
3) Je joins les deux classeur toto et titi.

Si quel qu'un pourrais m'aider pou me donner des piste pour résoudre mon problème qui me prends la tête depuis plusieurs jours.


Sub extrac()

Workbooks.Open Filename:="toto.xls"
intIndiceLigne1 = 1
Workbooks("titi.xls").Sheets("Donnees").Activate
Workbooks("toto.xls").Sheets("Feuil1").Activate
While Cells(intIndiceLigne1, 2) <> Empty
ser = Trim(Cells(intIndiceLigne1, 2))
class = Trim(Cells(intIndiceLigne1, 4))
Workbooks("titi").Sheets("Donnees").Activate
i = 15
Do While Cells(i, 1) <> ""
If Cells(i, 1) = ser Then
ligne = Cells(i, 2)
Exit Do
Else
i = i + 1
End If
Loop
i = 15
Do While Cells(i, 2) <> ""
If Cells(i, 2) = class Then
ligne1 = Cells(i, 4)
Exit Do
Else
i = i + 1
End If
Loop
For i = 1 To 9
Workbooks("titi.xls").Sheets("Donnees").Cells(ligne + ligne1, 2 + i) = CLng(Workbooks("toto.xls").Sheets("Feuil1").Cells(intIndiceLigne1, 4 + i))
Next
intIndiceLigne1 = intIndiceLigne1 + 1
Workbooks("toto.xls").Sheets("Feuil1").Activate
Wend
Workbooks("toto.xls").Close SaveChanges:=False

End Sub

Merci pour votre aide

Bulis