Private Sub CommandButton1_Click()
Dim cellule As Range, dest As Range, produit As Range
Dim trouve As Boolean
Application.ScreenUpdating = False
For Each cellule In Range([A2], [A65536].End(xlUp))
trouve = False
If cellule.Value <> "" And cellule.Value <> 0 Then
'ci-dessous on vérifie que la feuille du fournisseur existe
For i = 1 To Sheets.Count
If Sheets(i).Name = cellule.Offset(0, 3).Value Then
trouve = True
Exit For
End If
Next
'si la feuille n'existe pas, on la crée
If Not trouve Then
Workbooks.Open ("[COLOR=Blue][B]E:\VBA excel\Forum Excel-Download\[/B][/COLOR]trame.xls")
ThisWorkbook.Activate
Workbooks("trame.xls").Sheets("Feuil1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = cellule.Offset(0, 3).Value
.[B3].Value = cellule.Offset(0, 3).Value
End With
Workbooks("trame.xls").Close savechanges:=False
End If
'on colle les infos
With Sheets(cellule.Offset(0, 3).Value)
'on regarde si le produit existe déjà pour le fournisseur, dans le cas contraire on l'ajoute.
Set produit = .Columns("B").Find(cellule.Offset(0, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
If produit Is Nothing Then
Set dest = .[A65536].End(xlUp).Offset(1, 0)
Else: Set dest = produit.Offset(0, -1)
End If
dest.Value = cellule.Offset(0, 2).Value 'référence
dest.Offset(0, 1).Value = cellule.Offset(0, 1).Value 'produit
dest.Offset(0, 2).Value = cellule.Value 'qtés
dest.Offset(0, 3).Value = cellule.Offset(0, 4).Value 'prix unit.
dest.Offset(0, 4).Value = cellule.Offset(0, 4).Value * cellule.Value 'prix tot.
End With
End If
Next
Sheets("Maitre").Activate
Application.ScreenUpdating = True
End Sub