Copier/Coller les onglet VBA

Résolu
zizou026 Messages postés 102 Statut Membre -  
zizou026 Messages postés 102 Statut Membre -
Bonjour,
Dans la cellule A1, en cliquant sur le bouton 1, je souhaite copier les données de la feuille 1 dans l'onglet Report ensuite copier à partir de X les données de la feuille2 idem pour la feuille 3 (sans les entête pour les feuille 2 et 3). Copier les données 1 en bleu clair, données 2 en vert clair et données 3 en marron clair.
Par avance, je vous remercie de votre aide et vous souhaite une excellente journée.
Cordialement,
Zizou
https://www.cjoint.com/c/KHffRbmmpeA

4 réponses

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    pour copier une plage de cellule:

    https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.copy

    pour trouver la dernière ligne:

    https://excel-malin.com/tutoriels/vba-tutoriels/vba-trouver-la-derniere-cellule-utilisee/

    et pour la couleur:

    https://www.excel-pratique.com/fr/vba/couleurs

    ce qui donne : 

    Option Explicit
Sub test()
Dim DerniereLigneUtilisee As Long
Dim DerniereCellule_Adresse
DerniereCellule_Adresse = Worksheets("Feuil1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("Feuil1").Range("A1:" & DerniereCellule_Adresse).Copy _
    Destination:=Worksheets("Report").Range("A1")
    DerniereCellule_Adresse = Worksheets("Report").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Range("A1:" & DerniereCellule_Adresse).Font.ColorIndex = 41 'bleu clair
    DerniereLigneUtilisee = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row + 1
DerniereCellule_Adresse = Worksheets("Feuil2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("Feuil2").Range("A2:" & DerniereCellule_Adresse).Copy _
    Destination:=Worksheets("Report").Range("A" & DerniereLigneUtilisee)
    DerniereCellule_Adresse = Worksheets("Report").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Range("A" & DerniereLigneUtilisee & ":" & DerniereCellule_Adresse).Font.ColorIndex = 10 ' vert
    DerniereLigneUtilisee = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row + 1
DerniereCellule_Adresse = Worksheets("Feuil3").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("Feuil3").Range("A2:" & DerniereCellule_Adresse).Copy _
    Destination:=Worksheets("Report").Range("A" & DerniereLigneUtilisee)
        DerniereCellule_Adresse = Worksheets("Report").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Range("A" & DerniereLigneUtilisee & ":" & DerniereCellule_Adresse).Font.ColorIndex = 40 ' marron clair
End Sub
'https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.copy
'https://www.excel-pratique.com/fr/vba/couleurs
'https://excel-malin.com/tutoriels/vba-tutoriels/vba-trouver-la-derniere-cellule-utilisee/


    affecter cette macro à un raccourci clavier, car le bouton ce n'est pas judicieux car les données copiées vont se trouver sur cette feuille!

    Voilà

    1
    1. zizou026 Messages postés 102 Statut Membre 1
       
      Bonjour,
      Sans abuser de ta gentillesse, je souhaite une information que je ne comprends pas.
      Ta formule fonctionne parfaitement BIEN. Lorsque je l'ai adapté à mon tableau sur deux onglets l'un est correctement copier (avec toutes les informations) par contre l'autre ne prend que les deux premiers colonne.
      Je ne comprends pas le problème (les deux onglets sont extraites à partir d'un macro, penses-tu qu'il y a incidence?
      Par avance, je te remercie de ton aide.
      Cordialement,
      Azis
      0
    2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > zizou026 Messages postés 102 Statut Membre
       
      il faut l'adapter.
      Je t'ai mis le code avec les commentaires pour l'adapter; 

      Option Explicit
Sub test() 'Ctrl w
'déclaration variable
Dim DerniereLigneUtilisee As Long
Dim DerniereCellule_Adresse As Variant
'copie feuil1 --> Report
DerniereCellule_Adresse = Worksheets("Feuil1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("Feuil1").Range("A1:" & DerniereCellule_Adresse).Copy _
    Destination:=Worksheets("Report").Range("A1")
    'couleur
    DerniereCellule_Adresse = Worksheets("Report").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Range("A2:" & DerniereCellule_Adresse).Font.ColorIndex = 5 'bleu
    'copie feuil2 --> Report
    DerniereLigneUtilisee = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row + 1
DerniereCellule_Adresse = Worksheets("Feuil2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("Feuil2").Range("A2:" & DerniereCellule_Adresse).Copy _
    Destination:=Worksheets("Report").Range("A" & DerniereLigneUtilisee)
    'couleur
    DerniereCellule_Adresse = Worksheets("Report").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Range("A" & DerniereLigneUtilisee & ":" & DerniereCellule_Adresse).Font.ColorIndex = 4 'vert
    'copie feuil3 --> Report
    DerniereLigneUtilisee = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row + 1
DerniereCellule_Adresse = Worksheets("Feuil3").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("Feuil3").Range("A2:" & DerniereCellule_Adresse).Copy _
    Destination:=Worksheets("Report").Range("A" & DerniereLigneUtilisee)
      'couleur
        DerniereCellule_Adresse = Worksheets("Report").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Range("A" & DerniereLigneUtilisee & ":" & DerniereCellule_Adresse).Font.ColorIndex = 26 'Fuchsia
End Sub
'


      Voilà

      @+ Le Pivert
      0
    3. zizou026 Messages postés 102 Statut Membre 1 > cs_Le Pivert Messages postés 8437 Statut Contributeur
       
      Bonjour et merci de ton aide et de ta gentillesse,
      Il ne veut pas et reprend toujours 2 colonnes. Au lieu qu'il cherche la dernière cellule automatiquement, peut-on définir de copier de A à L?
      Bien à toi,
      Zizou
      0
    4. cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > zizou026 Messages postés 102 Statut Membre
       
      peut-on définir de copier de A à L?

      OUI en consultant le lien donné post3:

      pour copier une plage de cellule:

      à+
      0
    5. zizou026 Messages postés 102 Statut Membre 1 > cs_Le Pivert Messages postés 8437 Statut Contributeur
       
      Bonsoir cs_Le Pivert,
      J'ai repris la formule du post3, ça reprends les données de A à L mais seulement 3 lignes de A1 à A3.
      Par contre, j'ai gardé ta formule pour l'onglet Feuil2 et Feuil3 qui fonctionnent impeccablement.
      Merci pour ta patience et ton aide, je te souhaite une excellente soirée.
      Cordialement,
      Zizou
      0
  2. Yoyo01000 Messages postés 1720 Date d'inscription   Statut Membre Dernière intervention   168
     
    Bonjour,
    avez-vous essayé de passer par l'enregistreur de macro ? Et ensuite rattacher celle-ci à votre bouton...
    0
  3. zizou026 Messages postés 102 Statut Membre 1
     
    Bonjour,
    Merci pour votre réponse, je n'ai pas fait de macro car je ne sais pas comment définir le X (les dernières lignes sont variables).
    Cordialement,
    Azis
    0
  4. zizou026 Messages postés 102 Statut Membre 1
     
    Bonjour cs_Le Pivert,
    Du sûr mesure, excellent. Un grand merci à toi et ce forum d'être là...
    @+++
    Zizou
    0

Discussions similaires

dessin avec symbole clavier
JSS -
Adraen -

79 réponses
Arobase
Zezette -
MPMP10 -

1 réponse
dessin au clavier cannabis
val2t1 -
Mamaaaa18 -

10 réponses