Copier/Coller

Résolu/Fermé

JSCH19 Messages postés 129 Date d'inscription mercredi 30 octobre 2019 Statut Membre Dernière intervention 22 juin 2023 - 20 nov. 2022 à 06:23
JSCH19 Messages postés 129 Date d'inscription mercredi 30 octobre 2019 Statut Membre Dernière intervention 22 juin 2023 - 21 nov. 2022 à 18:47

Bonjour le Forum,

je galere depuis un certain temps pour arriver a simplifier une formule de copier/coller d'une selection.

je veux copier des donnees d'une feuille A pour les coller sur une feuille B.les elements d'informations dont je veux copier est sur la forme de range("A2:B64") puis les coller sur la 4 colonnes du tableau de la Feuille B.

NB:Mon Tableau comporte 5 colonnes.

voila le code dont je veux simplifier:

Dim B As Long,C As Long, dl As Long, I As Long, I2 As Long
Dim tb As ListObject, tb1 As ListObject, rg As Range, rg1 As Range


dl = Sheet60.Range("A" & Rows.Count).End(xlUp).row

Set tb = Sheet61.ListObjects("Table61")

For I = 2 To dl
     If Sheet60.cells(I, 1).Value <> Empty Then 
        Sheet60.cells(I, 1).Copy  'range("A2:B64")
        Sheet61.Activate
        B = Sheet61.Range("B1048575").End(xlUp).row
        Set rg = tb.Range
        Set rg = rg.Resize(rg.Rows.Count + 1)
        tb.Resize Range(rg.Address)
        Sheet61.cells(B + 1, 4).Select
        Sheet61.PasteSpecial
   End If
Next I

For I2 = 2 To dl
     If Sheet60.cells(I2, 1).Value <> Empty Then 
        Sheet60.cells(I2, 2).Copy  
        Sheet61.Activate
        C = Sheet61.Range("B1048575").End(xlUp).row
        Set rg1 = tb1.Range
        Set rg1 = rg1.Resize(rg1.Rows.Count + 1)
        tb1.Resize Range(rg1.Address)
        Sheet61.cells(B + 1, 5).Select
        Sheet61.PasteSpecial
   End If
Next I2

Voila ma proposition mais les donnees ont été multipliées ce qui change drastiquement le resultat escompté.

For I = 2 To dl
     If Sheet60.cells(I, 1).Value <> Empty Then
        Sheet60.Range("A2:B64").Copy  'cells(I, 1)
        Sheet61.Activate
        B = Sheet61.Range("B1048575").End(xlUp).row
        Set rg = tb.Range
        Set rg = rg.Resize(rg.Rows.Count + 1)
        tb.Resize Range(rg.Address)
        Sheet61.cells(B + 1, 4).Select
        Sheet61.PasteSpecial
   End If
Next I

A voir également:

Copier/Coller
Copier coller pdf - Guide
Copier une vidéo youtube - Guide
Super copier - Télécharger - Gestion de fichiers
Dessin sms copier coller - Forum Jeux vidéo
Copier coller formule excel sans décalage ✓ - Forum Bureautique

2 réponses

Réponse 1 / 2

yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
Modifié le 20 nov. 2022 à 10:07

bonjour,

Ton code et ta description ne semblent pas correspondre.

Peux-tu expliquer plus précisément ce que tu veux faire? à tout hasard:

dim rgsource as range, rgdest as range, lgdest as long, dlsource as long
dim tb As ListObject, rgtb as range

dlsource = Sheet60.Range("A" & Rows.Count).End(xlUp).row
set rgsource = Sheet60.range(cells(2,"a"),cells(dlsource,"b"))

lgdest = Sheet61.Range("B1048575").End(xlUp).row + 1
set rgdest = Sheet61.cells(lgdest, 4)

Set tb = Sheet61.ListObjects("Table61")
Set rgtb = tb.Range
Set rgtb = rgtb.Resize(rgtb.Rows.Count + rgsource.Rows.Count)
tb.Resize rgtb

rgsource.copy rgdest

Réponse 2 / 2

JSCH19 Messages postés 129 Date d'inscription mercredi 30 octobre 2019 Statut Membre Dernière intervention 22 juin 2023
20 nov. 2022 à 15:17

Bonjour yg_be,ce que je cherche a faire réellement c’est de copier des données d’une feuille A qui est sous la forme range(“A2:B6”) dans un tableau sur une feuille B. Je suis parvenu en copiant une colonne de la feuille A mais quand j’essaie avec une avec une colonne je parviens a le coller mais quand il s’agit de deux colonnes ca se colle dans le tableau mais se multiplie un bon nombre de fois. Qui change tout puisque il y a 63 lignes dans la feuilles A ce qui devrait etre 63 lignes collées dans la feuille B mais nn cela se multiplie jusqu’à a 4000.

yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
20 nov. 2022 à 18:38

Ton premier code fonctionne vraiment? Bizarre!

As-tu testé ma suggestion?

Moi je changerais la ligne 3 de ton second code:

Sheet60.Range(cells(I, 1),cells(I, 2)).copy

JSCH19 Messages postés 129 Date d'inscription mercredi 30 octobre 2019 Statut Membre Dernière intervention 22 juin 2023 > yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024
20 nov. 2022 à 18:59

J’avais deja essayé ca cela n’avait pas fonctionné

yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477 > JSCH19 Messages postés 129 Date d'inscription mercredi 30 octobre 2019 Statut Membre Dernière intervention 22 juin 2023
20 nov. 2022 à 19:40

Comme tu ne réponds pas aux questions, peux-tu partager un fichier d'exemple?

https://drive.google.com/file/d/1GzTde5t4JAKRZJf2lPR9uqZQ2z5723-4/view?usp=share_link

voici le lien.

ainsi:

Private Sub tyg()
Dim rgsource As Range, rgdest As Range, lgdest As Long, dlsource As Long
Dim tb As ListObject, rgtb As Range, flsource As Worksheet, fldest As Worksheet

Set flsource = Worksheets("Sheet1")
dlsource = flsource.Range("A" & flsource.Rows.Count).End(xlUp).Row
Set rgsource = flsource.Range(flsource.Cells(2, "a"), flsource.Cells(dlsource, "b"))

Set fldest = Worksheets("Sheet2")
lgdest = fldest.Range("B1048575").End(xlUp).Row + 1
Set rgdest = fldest.Cells(lgdest, 4)

Set tb = fldest.ListObjects("Table1")
Set rgtb = tb.Range
Set rgtb = rgtb.Resize(rgtb.Rows.Count + rgsource.Rows.Count)
tb.Resize rgtb

rgsource.Copy rgdest
End Sub

Copier/Coller

2 réponses

Discussions similaires

Newsletters