Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Copier / Coller dans 52 Onglets

  • Initiateur de la discussion Initiateur de la discussion Caldric
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

C

Caldric

Guest
Bonjour à tous,

Dans un tableau de planning du personnel, j'aimerai pour voir copier les infos d'une plage vers un onglet me permettant de créer un base.

J'ai le code suivant :

Sub Suivi ()

Sheets("1").Select
Range("AU6:AW100").Select
Selection.Copy
Sheets("SUIVI").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

Ce code me permet de copier les infos de l'onglet "1" vers mon onglet "Suivi",je n'arrive pas à créer la boucle me permetant d'enchainer la copie sur 52 onglets et coller les infos à la suite...

Et je suis trop fénéant pour copier le code 52 fois et modifier la zone à coller sans compter le poids du code.

Quelqu un aurait il une piste.

D'avance Merci

Cordialement
 
Re : Copier / Coller dans 52 Onglets

Bonjour Caldric,

Voici une solution.
Code:
Sub Suivi()
    Dim nbWS As Integer
    Dim derLig As Long
    
    For nbWS = 1 To 52
        ' Dernière ligne en colonne B dans la feuille Suivi
        derLig = Sheets("SUIVI").Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
        If derLig < 5 Then derLig = 5
        
        ' Copier de la feuille 1...52 vers la feuille Suivi
        Sheets(nbWS).Range("AU6:AW100").Copy
        Sheets("Suivi").Range("B" & derLig).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next nbWS
End Sub
 
Re : Copier / Coller dans 52 Onglets

BONJOUR caldric le forum un code a adapter

Sub test1()
Dim s As Byte
Application.ScreenUpdating = False
For s = 1 To 52
Sheets(s).Activate: Range("AU6:AW100").Copy Destination:=Sheets("suivi").Range("B65536").End(xlUp)(2)
Next s
End Sub

salut cbea pas vu
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
10
Affichages
791
Réponses
18
Affichages
597
Réponses
2
Affichages
399
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…