XL 2010 Copier Coller à la suite,

lelebl

XLDnaute Nouveau
Bonjour France travailleuse,
Aujourd'hui je suis à la recherche d'une base du VBA sur Excel ( et oui les jeunes). Je voudrais le plus simplement du monde copier à la suite des valeurs, j'ai recherché partout l'information je ne l'ai pas trouvé et dieu sais que c'est quelque chose de demandé j'en suis sûre, j'aimerai le plus simplement du monde savoir comment copier d'un point A à un point B des valeurs, bien sûre il y a une astuce,
Ma colonne A de mon tableau A (en feuil1) , doit aller de la première cellule de la feuille 3 jusqu'à la qu'il n'y ai plus de ligne à coller, alors à ce moment la la colonneA feuille 2 doit venir sous les données de la Colonne A feuille 3.

Merci d'avance pour vos réponses, qui j'en suis sure seront instructive
 

Pièces jointes

  • Lebl Exemple Cp. Coller.xlsx
    8.9 KB · Affichages: 11

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

VB:
Sub copiercolleralasuite()
    Dim dest As Range
    Set dest = Feuil3.Range("A1")
    If dest <> "" Then Set dest = Feuil3.Cells(Rows.Count, 1).End(xlUp)(1)
    Feuil1.Range(Feuil1.Cells(1, 1), Feuil1.Cells(Rows.Count, 1).End(xlUp)).Copy dest
    Set dest = Feuil3.Cells(Rows.Count, 1).End(xlUp)(2)
    Feuil2.Range(Feuil2.Cells(1, 1), Feuil2.Cells(Rows.Count, 1).End(xlUp)).Copy dest
End Sub
P.S: les explications sont
A+
 
Dernière édition:

lelebl

XLDnaute Nouveau
J'ai résolu mon problème, et pour pouvoir gagner du temps j'ai donc créer une autre façon de travailler, qui me prendrait moins de temps, je m'explique, j'ai utilisé cette méthode pour pouvoir rechercher plus facilement, mais j'aiai donc découvert que je pourrai gagner du temps avec un si , j'aimerai réaliser maintenant un
"De La première à la dernière cellule remplit de colonne A ( .Range"A3;A"& DernièreLigne)
Si, CelluleA, colonne A apparait au moins une fois : donc NB.SI(CelluleA, ColonneA>0)
alors rechercheV sur tableau B
Sinon
RechercheV sur Tableau C,
il me faudrait de l'aide surtout pour le premier si, ensuite je crois être capable de réaliser la suite,

RBLCVIE
Malheureusement plus facile à dire que à faire...
 

job75

XLDnaute Barbatruc
Bonjour lelebi, Roblochon, le forum,

Voyez le fichier joint avec cette formule en Feuil3!A1 à tirer vers le bas :
Code:
=""&SI(LIGNE()<=SIERREUR(EQUIV("zzz";Feuil1!A:A);0);INDEX(Feuil1!A:A;LIGNE());INDEX(Feuil2!A:A;LIGNE()-SIERREUR(EQUIV("zzz";Feuil1!A:A);0)))
Fonctionne si toutes les valeurs en colonne A de Feuil1 sont des textes ou si les cellules sont vides.

A+
 

Pièces jointes

  • Lebl Exemple(1).xlsx
    15 KB · Affichages: 10

job75

XLDnaute Barbatruc
Une formule plus compliquée dans ce fichier (2) s'il peut y avoir aussi des nombres en Feuil1 :
Code:
=SI(LIGNE()<=MAX(SIERREUR(EQUIV("zzz";Feuil1!A:A);0);SIERREUR(EQUIV(9^99;Feuil1!A:A);0));INDEX(Feuil1!A:A;LIGNE());INDEX(Feuil2!A:A;LIGNE()-MAX(SIERREUR(EQUIV("zzz";Feuil1!A:A);0);SIERREUR(EQUIV(9^99;Feuil1!A:A);0))))
 

Pièces jointes

  • Lebl Exemple(2).xlsx
    16.4 KB · Affichages: 5

job75

XLDnaute Barbatruc
En parcourant les fils ouverts par lelebl je vois qu'il veut apprendre le VBA et éliminer les doublons.

Alors pour qu'il fasse connaissance avec le Dictionary :
VB:
Private Sub Worksheet_Activate()
Dim a, d As Object, n As Integer, tablo, i As Long
a = Array("Feuil1", "Feuil2") 'noms des feuilles à copier, à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For n = 0 To UBound(a)
    tablo = Sheets(a(n)).UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo) 'remplacer 1 par 2 si ligne de titre
        If tablo(i, 1) <> "" Then d(tablo(i, 1)) = ""
    Next
Next
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1] 'cellule de destination, à adapter
    If d.Count Then .Resize(d.Count) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
    .Offset(d.Count).Resize(Rows.Count - d.Count - .Row).ClearContents 'RAZ en desous
End With
End Sub
Fichier joint, la macro se déclenche quand on active Feuil3.
 

Pièces jointes

  • Lebl Exemple VBA(1).xlsm
    23.2 KB · Affichages: 6

lelebl

XLDnaute Nouveau
Je suis donc repassé sur un format classique,
Sub CopierCollerClient()
Dim dest As Range
Set dest = Sheets("CACNC").Range("A1")
'Le 2ème numéro désigne la colonne ou coller les valeurs de A
If dest <> "" Then Set dest = Sheets("CACNC").Cells(Rows.Count, 3).End(xlUp)(1)
Sheets("CA").Range(Feuil1.Cells(3, 25), Sheets("CA").Cells(Rows.Count, 25).End(xlUp)).Copy dest

'Le 2ème numéro désigne l'emplacement ou coller la feuille 2
Set dest = Sheets("CACNC").Cells(Rows.Count, 3).End(xlUp)(2)
'Premier chiffre désigne la première valeur de la plage à copier, après le row designe le numéro de colonne à copier
Sheets("CNC").Range(Sheets("CNC").Cells(3, 17), Sheets("CNC").Cells(Rows.Count, 17).End(xlUp)).Copy dest
End Sub
Malheureusement, je traite les cellules de CA par une formule avant de les copier, comment pourrais je faire pour seulement copier les valeurs sde CA? J'ai essayé avec pastevalues, mais le format ne convient pas du tout, en sachant que le macro game ne ma point aider non plus
Professionellement Votre,
Johnny English
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

un pastespecial valeur et ensuite format

VB:
Sub copiercolleralasuite()
    Dim dest As Range
    Set dest = Feuil3.Range("A1")
    '
    '
    If dest <> "" Then Set dest = Feuil3.Cells(Rows.Count, 1).End(xlUp)(1)
    PasteMoiSpecialement Feuil1.Range(Feuil1.Cells(1, 1), Feuil1.Cells(Rows.Count, 1).End(xlUp)), dest
    '
    '
    Set dest = Feuil3.Cells(Rows.Count, 1).End(xlUp)(2)
    PasteMoiSpecialement Feuil2.Range(Feuil2.Cells(1, 1), Feuil2.Cells(Rows.Count, 1).End(xlUp)), dest

End Sub

Sub PasteMoiSpecialement(origine As Range, destination As Range)
    origine.Copy
    destination.PasteSpecial xlPasteValues
    destination.PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
End Sub

Bon après-midi
 

Discussions similaires

Réponses
56
Affichages
906

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo