Générer des Feuilles par fournisseur

[Raziel abel]

Bonjour et bon Dimanche à tous!

Je voulais savoir si vous pouvez arriver au résultat du fichier ci-joint sans passer par le résultat d'un filtre et d'un copier-coller dans une autre feuille.
Je veux filtrer par fournisseur.

Pouvez vous réaliser cela?

En vous remerciant par avance.

Cordialement

 

[Staple1600]

Re : Générer des Feuilles par fournisseur

Bonsoir à tous

Raziel Abel
En attendant mieux et parce que fainéantise oblige, voici un code glané sur le net et modifié pour répondre à ton besoin
(test OK sur ton fichier joint)
Avant de lancer la macro SplitData, ne garder que la feuille 1 et supprimer les autres.

NB: Pour trouver d'autres codes, faire par exemple une recherche sur le net avec ces mots clés:
vba excel split worksheet

Sub SplitData() 'EDITION version modifiée pour copier la ligne d'entête
'code initial d'Alex P. ->-> stackoverflow
    Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

    Set Names = Range(Cells(2, "D"), Cells(Rows.Count, "D").End(xlUp))
    n = 0
    DeleteWorksheets

    For Each name In Names
        If name.Offset(1, 0) <> name Then
            ReDim Preserve DataMarkers(n)
            DataMarkers(n) = name.Row
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
            n = n + 1
        End If
    Next name
'
    For i = 0 To UBound(DataMarkers)
        If i = 0 Then
        Worksheets(1).Range("A1:R1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("A2:R" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        Else
        Worksheets(1).Range("A1:R1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & ":R" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        End If
    Next i
End Sub

Sub DeleteWorksheets()
    Dim ws As Worksheet, activeShtIndex As Long, i As Long

    activeShtIndex = ActiveSheet.Index

    Application.DisplayAlerts = False
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        If i <> activeShtIndex Then
            Worksheets(i).Delete
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

 

[Raziel abel]

Re : Générer des Feuilles par fournisseur

Bonsoir,

Merci pour ton aide.

Cordialement,

 

[Raziel abel]

Re : Générer des Feuilles par fournisseur

Bonjour,

J'ai essayé mais je n'y suis pas arrivé.
Vraiment désolé.

Est ce possible, d'avoir le code intégré dans le fichier?

En vous remerciant.

Cordialement,

 

[Raziel abel]

Re : Générer des Feuilles par fournisseur

Bonjour à tous,

un tout petit UP.
Merci pour votre aide.