Copier / Coller dans 52 Onglets

[Caldric]

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

 

[cbea]

Re : Copier / Coller dans 52 Onglets

Bonjour Caldric,

Voici une solution.

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

 

[excalibur]

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

 

[Caldric]

Re : Copier / Coller dans 52 Onglets

Merci à vous 2,

Cela marche nickel, je me suis servi des 2 codes pour en faire un...

Cordialement