Discussion :

[AlejandroD]

Bonjour,

Je suis nouveau dans ce forum que j'ai découvert grâce a un cours VBA de la mairie de Paris.

Je suis donc débutant en VBA (je commence a peine a écrire des macros simples).

Dans le fichier ci-joint, je souhaite dupliquer une ligne autant de fois qu'il y a de cellules comportant un X dans les colonnes "taille". Ensuite j'aimerais rajouter la taille dans chaque file dupliqué.

POINT DE DEPART

Année saison Collection Reference prod Style produit 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
2024 1 Summer 24 Sneakers bleue 734731-W3XLG x x x x x x x x x
2024 1 Summer 24 Sneakers grise 734732-W3XLG x x x



OBJECTIF

Année saison Collection Reference prod Style produit Taille
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 34
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 35
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 36
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 37
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 38
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 39
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 40
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 41
2024 1 Summer 24 Sneakers bleue 734731-W3XLG 42
2024 1 Summer 24 Sneakers grise 734732-W3XLG 37
2024 1 Summer 24 Sneakers grise 734732-W3XLG 38
2024 1 Summer 24 Sneakers grise 734732-W3XLG 39


Si quelqu'un peut m'aider avec ce code je lui en serai très reconnaissant.

Merci!Dupliquer references par taille.xlsx

[Franc]

Bonsoir, voici:

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
33
34
35
36
37
38
39
40
Sub CopierVersObjectif()
 
    Dim wsDepart As Worksheet
    Dim wsObjectif As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long, destRow As Long
 
    ' Définir les feuilles de travail
    Set wsDepart = ThisWorkbook.Sheets("Depart")
    Set wsObjectif = ThisWorkbook.Sheets("Objectif")
 
    ' Trouver la dernière ligne et la dernière colonne dans la feuille "Depart"
    lastRow = wsDepart.Cells(wsDepart.Rows.Count, "A").End(xlUp).Row
    lastCol = wsDepart.Cells(1, wsDepart.Columns.Count).End(xlToLeft).Column
 
    ' Désactiver temporairement l'affichage
    Application.ScreenUpdating = False
 
    ' Boucle à travers chaque ligne de la feuille "Depart"
    For i = 2 To lastRow
        ' Boucle à travers chaque colonne de E à dernière colonne
        For j = 5 To lastCol
            ' Vérifier si la cellule contient un "x"
            If wsDepart.Cells(i, j).Value = "x" Then
                ' Trouver la prochaine ligne disponible dans la feuille "Objectif"
                destRow = wsObjectif.Cells(wsObjectif.Rows.Count, 1).End(xlUp).Row + 1
 
                ' Copier les données de A à D dans la feuille "Objectif"
                wsDepart.Range("A" & i & ":D" & i).Copy wsObjectif.Range("A" & destRow)
 
                ' Copier l'entête de colonne avec un x dans la feuille "Objectif"
                wsDepart.Cells(1, j).Copy wsObjectif.Cells(destRow, 5)
            End If
        Next j
    Next i
 
    'Réactiver l'affichage
    Application.ScreenUpdating = True
 
End Sub

[AlejandroD]

Incroyable, quelle rapidité! Un grand merci, ce forum est un joyau