Macro : dupliquer des lignes articles et ajoute les codes en fonction des département

Version imprimable

14/02/2012, 11h14
roidurif

1 pièce(s) jointe(s)

Macro : dupliquer des lignes articles et ajoute les codes en fonction des département

Bonjour,

Je souhaite créer une macro qui duplique les lignes articles et ajoute les codes correspondant aux départements indiquer dans la table Département.

je vous joins un exemple de résultat à obtenir avec la table de correspondance et des explications.

Je vous remercie de votre aide.
14/02/2012, 11h41
Jean-Philippe André

:salut:

passer par Access pour ce genre de chose, c'est envisageable ? :calim2:

je te donne les pistes de reflection sur le code :
- utiliser la fonction SPlit() sur la colonne F pour recuperer la liste des departements
- utiliser une boucle for pour trouver dans la feuille 'Table DPT' le début des Code
- Inserer une nouvelle ligne dans Grille de depart
- ajouter le code dans la colonne G

a ton tour de faire avancer le schmiblick :ccool:

salut:

Merci du conseil,

J'ai commencé à réflechir, et voici ce que j'ai pu faire pour les duplications des article.

Ensuite, Je ne sais pas comment faire pour remplir les codes en fonction des DPT?

J'aimerais avoir un petit coup de pouce svp.

Merci
Code:

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 Sub dupliques() Dim i As Long 'Dim Inb As Integer Dim j As Integer Dim tablo i = 2 Do While Range("B" & i).Value <> "" Inb = Range("F" & i).Value tablo = Split(Inb, " ") nbmots = nbmots + UBound(tablo) + 1 'Range("F" & i).Value = 1 For j = 2 To nbmots Rows(i).Copy Rows(i + 1).Insert Shift:=xlDown 'Range("F" & i + 1).Value = 1 Next j i = i + nbmots Loop End Sub

Bonjour,

Ci dessous une proposition de code

Code:

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
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Dept()
 
Dim ShSource As Worksheet
Dim ShCible As Worksheet
Dim Shdept As Worksheet
 
Dim Rg As Range
 
Dim i As Long
Dim iCible As Long
Dim Idept As Long
Dim Itableau As Integer
Dim strdept() As String
 
Set ShSource = ThisWorkbook.Worksheets("Grille de départ")
Set ShCible = ThisWorkbook.Worksheets("Grille Résultat à obtenir")
Set Shdept = ThisWorkbook.Worksheets("Table DPT")
 
 
For i = 2 To ShSource.Range("A" & Rows.Count).End(xlUp).Row
    'Insere les département dans la variable tableau
    strdept = Split(ShSource.Range("F" & i).Value, " ")
    'Traite chaque département
    For Itableau = 0 To UBound(strdept)
        'recherche le département
        Set Rg = Shdept.Range("A:A").Find(what:=strdept(Itableau), lookat:=xlWhole)
        'Traitement si trouvé
        If Not Rg Is Nothing Then
            Idept = Rg.Row
            Do While Shdept.Range("A" & Idept).Value = strdept(Itableau) Or Shdept.Range("A" & Idept).Value = ""
                'Cherche la prochaine ligne vide sur onglet cible
                iCible = ShCible.Range("A" & Rows.Count).End(xlUp).Row + 1
                'Copie de la ligne source sur feuille cible
                ShSource.Rows(i).Copy ShCible.Range("A" & iCible)
                ShCible.Range("G" & iCible).Value = Shdept.Range("B" & Idept).Value
 
                Idept = Idept + 1
            Loop
 
        End If
    Next Itableau
 
Next i
 
End Sub

14/02/2012, 16h18
roidurif

Bonjour jfontaine,

Merci pour votre aide, je vais testé et je vous tiendrai au courant du résultat.

merci encore