Discussion :

[gaett]

Bonjour à tous,
Je viens solliciter votre aide car je bloque pour la création de ma macro. Je désirerais quelques informations et savoir si je pars dans la bonne direction avec le peu de code que j’ai. Et savoir si c'est possible

Le contexte :
J’ai deux feuilles, la premier « Builder » sur laquelle à partir de A8 j’ai différentes lignes les unes en dessous des autres (qui s’étendent sur 5 colonnes) dont la valeur utile se trouve sur la colonne A (Item).
Sur mon autre feuille « Sources », je retrouve en colonne A, les mêmes Valeurs (et d’autres qui sont inintéressantes dans cette situation) que sur ma feuille « Builder ». Et ces valeurs en feuille « sources » peuvent être multiples (je ne veux pas supprimer les doublons)…

Puis-je vous laisser lire mon fichier .doc, qui est imagé. J’ai dû mal à trouver les mots et je risque de vous (et de me) perdre pour expliciter ce que je désire réaliser.
Je voudrais dans un premier temps savoir si c’est réalisable car mes connaissances en VBA sont très (très) limitées et j’ai l’impression que ma requête est hyper complexe.

J’ai ce bout de code qui permet de copier une ligne (sur ma feuille initiale) d’une colonne à une autre et de la coller à l’endroit désiré (sur cette même feuille). Et d’incrémenter ce que je colle à la suite. Voir mon fichier xlm. Mais c’est tout ce que j’ai réussi à faire.

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
 
Sub findvalue()
 
Dim itemno As String
Dim finalrow As Integer
Dim i As Integer
 
itemno = Sheets("Builder").Range("A8").Value
finalrow = Sheets("Builder").Range("A10000").End(xlUp).Row
 
For i = 2 To finalrow
    If Cells(i, 1) = itemno Then
        Range(Cells(i, 1), Cells(i, 5)).Copy
        Range("F100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        End If
Next i
 
End Sub

Puis-je avoir vos avis et vous demander un peu d’aide ?
Avec mes remerciements avancés.

Gaëtan

[parmi]

Bonjour,

De la façon dont je vois le problème, je commencerais par insérer les lignes, puis copier les valeurs par la suite.
Quelque chose comme ceci

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
Sub findvalue()
    Dim itemno As String
    Dim finalrow As Long
    Dim i As Long, j As Long
    Dim nbLignesData As Long
    Dim CountData As Long
 
    finalrow = Sheets("Builder").Range("A10000").End(xlUp).Row
 
    Sheets("Sources").AutoFilterMode = False
    Sheets("Sources").Rows(2).AutoFilter
    nbLignesData = Sheets("Sources").Cells(Rows.Count, "A").End(xlUp).Row
 
    'On comence par insérer les lignes nécessaires
    For i = finalrow To 8 Step -1
        itemno = Sheets("Builder").Range("A" & i)
        CountData = Application.WorksheetFunction.CountIf(Sheets("Sources").Columns("A"), itemno)
        For j = 1 To CountData - 1
            Sheets("Builder").Rows(i + 1).Insert
        Next j
    Next i
 
    'Et on va chercher les données
    finalrow = Sheets("Builder").Range("A10000").End(xlUp).Row
    For i = 8 To finalrow
        itemno = Sheets("Builder").Range("A" & i)
        If itemno <> "" Then
            Sheets("Sources").Rows(2).AutoFilter Field:=1, Criteria1:=itemno
            CountData = Range("B3:F" & nbLignesData).SpecialCells(xlCellTypeVisible).Areas.Count
            If CountData > 0 Then
                Sheets("Sources").Range("B3:F" & nbLignesData).SpecialCells(xlCellTypeVisible).Copy
                Sheets("Builder").Range("F" & i).PasteSpecial
            End If
        End If
    Next
 
End Sub

[gaett]

Je viens de tester ta fonction, c'est ultra puissant, ça fonctionne !
Encore merci pour ton aide précieuse!