Discussion :

[Kevdel]

Bonjour,

Je souhaiterai faire une conversion à l'aide d'une macro pour obtenir une nomenclature trié par code article dans un nouveau classeur, mais je ne sais pas comment m'y prendre.

Pouvez vous m'aider, s'il vous plait?

En pièce jointe j'ai mis un classeur comportant 2 onglets.

Onglet 1 => BOM
La BOM est trié par code article dans laquelle il peut y avoir plusieurs repère topo séparé par virgule.

Onglet 2 => NOM
La NOM doit être trié par repère topo, il y aura 1 ligne par repère et par code.
Les quantité à "0" seront supprimées

J'ai mis un modèle dans chacun des onglets afin que vous puissiez voir ce dont j'ai besoin.

Dans l'attente de vous lire, je vous souhaite une bonne journée.

Salutations.

[ARTURO83]

Bonjour,

Ceci
Pièce jointe 574619

Le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Conversion_en_nomenclature()
    Dim DerLig_f1 As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Qte_Totale As Long, Qte As Long
    Dim i As Long, j As Long
    Dim Chaine As String, Rep
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("BOM")
    Set f2 = Sheets("NOM")
    f2.Range("Tableau2").ClearContents
    Lig = 2
    DerLig_f1 = f1.ListObjects("Tableau1").DataBodyRange.Rows.Count + 1
    For i = 2 To DerLig_f1
        Chaine = ", " & f1.Cells(i, "D")
        NbCar = Len(Chaine) - Len(Replace(Chaine, ",", ""))
        Qte_Totale = f1.Cells(i, "C")
        If Qte_Totale = 0 Or NbCar = 0 Then
            Qte = 0
        Else
            Qte = NbCar / Qte_Totale
        End If
        Rep = Split(Chaine, ", ")
        For j = 1 To UBound(Rep)
            f2.Cells(Lig, "A") = Rep(j)
            f2.Cells(Lig, "B") = f1.Cells(i, "A")
            f2.Cells(Lig, "C") = f1.Cells(i, "B")
            f2.Cells(Lig, "D") = Qte
            Lig = Lig + 1
        Next
    Next i
End Sub

Cdlt

[Kevdel]

Bonjour ARTURO83,

Je te remercie beaucoup, ça marche parfaitement.
Je vais essayer d'ajouter une ligne pour qu'une nouvelle feuille soit crée lorsque la macro se lance.

Merci encore

Bonne journée

[mfoxy]

Bonjour Kevdel,

Pour ajouter une nouvelle feuille, et la nommé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Sub CreateSheet()
Dim mytext as String
 
mytext = "Nom Feuille" 
 
    With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = mytext
    End With
End Sub

[Kevdel]

Bonjour mfoxy,

Je te remercie pour ton aide et te souhaite une bonne journée.

Salutations.