Copie de Cellules et coller en Ligne

Bonjour a tous,

J'ai pourtant chercher sur le net, mais n'ai rien trouvé correspondant a ma recherche.

En fait, j'ai crée une macro qui copie une cellule d'une feuille, puis va la coller à la dernière ligne vide d'une feuille d'un autre classeur.

Jusque la tout va bien.

La ou je coince, c'est que j'ai besoin de copier plusieurs cellules d'une feuille, a des endroits différents, et les coller en ligne sur l'autre classeur.

Du coup, je répète plusieurs fois la macro suivante :

Dim x As Integer

    ThisWorkbook.Sheets("DEVIS").Range("I5").Copy                      'NUMERO DEVIS
    Workbooks("Base_Donnée.xlsm").Sheets("Feuil1").Activate
    x = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row + 1          'On détecte la dernière ligne non vide + 1
        Range("A" & x).Select                                               'On sélectionne la dernière ligne non vide + 1
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Colle sans mise en forme

Y-a-t-il un moyen plus simple ?

Bonjour,

Un moyen plus simple est de charger les différentes valeurs à copier dans un array puis de coller l'array sur ta seconde feuille afin d'éviter les changements de feuilles incessants et les multiple copiés collés qui peuvent ralentir l’exécution. Par exemple :

Sub COPIE()
Dim REF()
Dim L%
With Worksheets("DATA")
    REF = Array(.[C4].Value, .[D7].Value, .[E11].Value, .[G10].Value)
End With
With Worksheets("BDD")
    L = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Cells(L, 1).Resize(, UBound(REF) + 1) = REF()
End With
End Sub

En lien avec le fichier joint. Je vous laisse adapter.

Si ça ne correspond pas merci de joindre un fichier représentatif anonymisé.

Cdlt,

J'avais pensé a la solution du Array, mais je ne la maitrise absolument pas.

Meme si dans votre exemple, cela me parle plus.

Je teste et je reviens vers vous