XL 2016 Copier/coller de plusieurs cellules non contigües d'une feuille vers une ligne d'une autre feuille

Makovitch

XLDnaute Nouveau
Bonjour, j'ai besoin d'une petite information sur mon code car il fonctionne bien mais avec un léger hic tout de même...
je souhaite copier plusieurs cellules (A2,A3,E4,H5...) contenant des critères dans un onglet "Feuille de saisie" pour les enregistrer vers un autre onglet appelé "Base". Jusqu'ici tout marche correctement, sauf qu'à la saisie de nouvelles critères, ma macro enregistre ces nouvelles données en écrasant celles d'avant je me retrouve avec deux lignes identiques de données dans ma base.
Comment puis-je conserver les données anciennes tout en enregistrant de nouvelles données dans ma base svp ?


Sub tranfert_saisie()
Dim tablo As Variant, derlig As Long
'array representant le nom des cellule de la fiche de saisie dans l'ordre dans le quel elles seront transposées
plage = Array("A2", "b2", "d3", "f4", "h8", "d8", "j4", "j8", "l4", "b8", "f10", "d11", "f13", "h3", "i11", "b11")
ReDim tablo(1, UBound(plage)) ' redimentionnement d'une varaible de type tableau avec le nombre d'element dans l'array
For i = 0 To UBound(plage)
'inscription des données des cellules dans chaque items da la variable tableau
tablo(0, i) = Sheets("Fiche de saisie").Range(plage(i))
Next
'recupération de la premiere ligne vide et libre de la feuille de destination
derlig = Sheets("Saisie enregistrée").Range("A" & Rows.Count).End(xlUp).Row + 1
'resize de la cellule A et derlig a la dimention du tableau et pose de du tablo
Range("A" & derlig).Resize(1, UBound(plage)) = tablo
End Sub
 

Makovitch

XLDnaute Nouveau
Pour faire plus simple, j'aimerai copier le tableau de données de ma feuille "feuille de saisie" en valeurs et sans les formules.
 

patricktoulon

XLDnaute Barbatruc
Bonjour
tu créé un array pourquoi tu t'en sert pas un peu comme un "Union"
pas la peine de créer un array d'adresse pour en faire un array de valeur c'est absurde
c'est simple
VB:
Sub test()
Dim tableau, Derlig&
With Sheets(1) 'remplacer 1 par l'index ou le nom de la sheets source
tableau = Array(.[A2], .[b2], .[d3], .[f4], .[h8], .[d8], .[j4], .[j8], .[l4], .[b8], .[f10], .[d11], .[f13], .[h3], .[i11], .[b11])
End With

With Sheets(2) 'remplacer 2 par l'index ou le nom du sheets de destination
Derlig = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(Derlig, "A").Resize(, UBound(tableau) + 1) = tableau
End With
End Sub
terminé
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas