Copier coller ligne fonction valeur d'une cellule

[doody51]

Bonjour,

Je suis de ne pas être le premier a poser ce genre de question, mais malgré mais nombreuses recherches sur le net je n'arrive pas à adapter de macro pour mon cas.

Je m'explique:

Dans mon fichier j'ai déjà créé une macro qui importe des données.

Mais une fois mes données importées c'est la que le problème se pose.

J'ai des donnés dans l'onglets LOCDET (Une ligne par article donc plusieurs lignes par devis).
De la dans mon anglet à facturer j'ai des numéro de DEVIS (je peux en avoir deux ou bien plus)
Mon but est de recherché dans LOCDET toutes les lignes qui comprennent les numéros de devis (forcément en colonne A) de l'onglet a facturer (colonne a aussi) et faire un copier coller des lignes entières dans l'onglets recap.

Je ne sais pas si je suis très clair mais n’hésitez pas ...

je vous joins un exemple.

Merci pour votre aide.

Doody

Ps J'ai du raccourcir énormément l'onglet LOCDET. Aujourd’hui il est sur quasiment 70000 lignes et 40 colonnes. IL ne fait que augmenter car il regroupe tous les devis depuis le début

 

[Paf]

Re : Copier coller ligne fonction valeur d'une cellule

bonjour

Si j'ai bien compris:

Sub doody51()
 Dim TabTemp, i As Long, j As Long, DerArt As Long, DerDevis As Integer, x As Long


 Application.ScreenUpdating = False

 DerDevis = Worksheets("A FACTURER").Range("A" & Rows.Count).End(xlUp).Row

 DerArt = Worksheets("LOCDET").Range("A" & Rows.Count).End(xlUp).Row
 TabTemp = Worksheets("LOCDET").Range("A2:J" & DerArt)
 For i = 1 To DerDevis
    For j = LBound(TabTemp) To UBound(TabTemp)
        If Worksheets("A FACTURER").Cells(i, 1) = TabTemp(j, 1) Then
            x = x + 1
            Worksheets("RECAP").Cells(x, 1).Resize(1, 10) = Application.Index(TabTemp, j)
        End If
    Next
 Next

 Application.ScreenUpdating = True

End Sub

lignes de code à adapter au fichier réel :
TabTemp = Worksheets("LOCDET").Range("A2:J" & DerArt) où J devra être remplacer par la lettre de la dernière colonne comportant des données

Worksheets("RECAP").Cells(x, 1).Resize(1, 10) = Application.Index(TabTemp, j) où 10 devra être remplacé par le nombre de colonnes

A+

 

[Paf]

Re : Copier coller ligne fonction valeur d'une cellule

Re

Une version beaucoup plus rapide

Sub doody51()
 Dim TabTemp, TabFin(), i As Long, j As Long, DerArt As Long, DerDevis As Integer, x As Long, Devis
 Dim k

 Application.ScreenUpdating = False

 DerDevis = Worksheets("A FACTURER").Range("A" & Rows.Count).End(xlUp).Row

 DerArt = Worksheets("LOCDET").Range("A" & Rows.Count).End(xlUp).Row
 TabTemp = Worksheets("LOCDET").Range("A2:J" & DerArt)
 For i = 1 To DerDevis
    Devis = Worksheets("A FACTURER").Cells(i, 1)
    For j = LBound(TabTemp) To UBound(TabTemp)
        If Devis = TabTemp(j, 1) Then
            x = x + 1
            ReDim Preserve TabFin(1 To 10, 1 To x)
            For k = 1 To 10
                TabFin(k, x) = TabTemp(j, k)
            Next
        End If
    Next
 Next

 Worksheets("RECAP").Cells(1, 1).Resize(UBound(TabFin, 2), UBound(TabFin, 1)) = Application.Transpose(TabFin)

 Application.ScreenUpdating = True
End Sub

Seule la ligne TabTemp = Worksheets("LOCDET").Range("A2:J" & DerArt) doit être adaptée

A+

 

[doody51]

Re : Copier coller ligne fonction valeur d'une cellule

Bonjour,

Merci beaucoup pour votre aide.
je n'ai pas eu le temps de regarder tout ca avant.
J'ai essayé et cela fonctionne parfaitement merci beaucoup