Extraction à l'intérieur d'une BD

Oui pardon. Ne pas tenir compte de ceux ayant fait 1 seul achat seulement.

Est-ce plus clair?

Oui affirmatif!!

Pas de quoi s'excuser, c'est avec plaisir.

Bonjour merci beaucoup pour l'aide.
Cependant, j'éprouve quelques petits problèmes. Je n'arrive pas à rouler la macro. J'ai changé les constantes. Cependant si le nom de mes colonnes diffères, dois-je les changer également à droite? Ex: Const cosceauFS = 25 ' colonne achat (ici achat doit devenir sceau?)

' constantes à modifier selon ta configuration
Const FS = "BD" ' nom feuille soource
Const lidebFS = 2 ' premier ligne données
Const codebFS = 1 ' premiere colonne données
Const nbco = 37 ' nombre de colonnes tableau
Const copermisFS = 26 ' colonne client
Const cosceauFS = 25 ' colonne achat

Const FB = "Doubles abbatages seulement" ' feuille but
Const lidebFB = 2 ' premiere ligne
Const codebFB = 1 ' première colonne

Je veux dire que la macro lorsque je l'applique à mon projet ne fonctionne pas... j'ai des message d'erreur...

même en remplacant les noms de colonnes...

J'ai toujours le même message d'erreur: erreur d'exécution '9'. L'indice n'appartient pas à la sélection....

Je vérifie mais rien.... Peut-être verra tu une erreur:

Désolé...

' constantes à modifier selon ta configuration
Const FS = "BD"   ' nom feuille soource
Const lidebFS = 2     ' premier ligne données
Const codebFS = 1     ' premiere colonne données
Const nbco = 37        ' nombre de colonnes tableau
Const copermisFS = 26  ' colonne client
Const cosceauFS = 25   ' colonne achat

Const FB = "Feuil4"   ' feuille but
Const lidebFB = 2     ' premiere ligne
Const codebFB = 6     ' première colonne

Public Sub Transfert()
Dim lifinFS As Long, TFS, nbliFS As Long, plageFS As Range, co As Long, liFS As Long
Dim client As String, achat As Long, nbachat As Long
Dim TFB, nbliFB As Long, liFB As Long
Dim t As Single
t = Timer
lifinFS = Sheets(FS).Cells(Rows.Count, codebFS).End(xlUp).Row
Set plageFS = Sheets(FS).Range(Cells(lidebFS, codebFS), Cells(lifinFS, codebFS + nbco - 1))
TFS = plageFS
nbliFS = plageFS.Rows.Count
nbliFB = Application.WorksheetFunction.SumIf(Columns(cosceauFS), ">=2")
ReDim TFB(1 To nbliFB, 1 To nbco)
liFS = 1
liFB = 1
On Error GoTo fin
Do
  achat = TFS(liFS, cosceauFS)
  While achat = 1
    liFS = liFS + 1
    achat = TFS(liFS, cosceauFS)
  Wend
  client = TFS(liFS, copermisFS)
  nbachat = 1
  For co = 1 To nbco
    TFB(liFB, co) = TFS(liFS - 1, co)
  Next co
  liFB = liFB + 1
  While TFS(liFS, copermisFS) = client
    For co = 1 To nbco
      TFB(liFB, co) = TFS(liFS, co)
    Next co
    liFS = liFS + 1
    liFB = liFB + 1
  Wend
Loop Until liFS >= nbliFS
fin:
Sheets(FB).Cells(lidebFB, codebFB).Resize(nbliFB, nbco) = TFB
MsgBox " temps mis " & Timer - t & " sec"
End Sub