Copie valeurs plusieurs lignes de plusieurs feuilles dans récapitulatif

Bonjour à tous,

Je cherche à copier les valeurs de cellules de lignes 7 à 77 de plusieurs feuilles dans un tableau récapitulatif.

En gros j'ai 12 onglets représentant les mois d'une année, je souhaite récupérer les valeurs d'une cellule correspondant à une machine pour les copier dans un tableau bilan correspondant au mois et à la machine. Sachant que j'ai 77 machines j'ai voulu réaliser mais une boucle sauf que cela ne récupère pas les valeurs et affiche à chaque fois 0.

Private Sub CommandButton1_Click()

    Dim x%, z%, y%
    With Sheets("BILAN")
        Range("C7:M77").ClearContents
        Application.ScreenUpdating = 0
        For x = 3 To Sheets.Count - 1
            For z = 7 To 77
                For K = 2 To 13
                y = Sheets(x).Columns("AC").Rows(z).Value
                Columns(K).Rows(z) = y
                Next K
            Next z
        Next x
    End With
End Sub

Je vous joins le fichier pour exemple.

Merci d'avance pour votre aide !

Cordialement.

9suivi-exemple.zip (330.52 Ko)

Bonjour Aurélien, bonjour le forum,

Peut-être comme ça :

Private Sub CommandButton1_Click()
Dim OD As Worksheet
Dim O As Worksheet

Set OD = Worksheets("BILAN")
For Each O In Worksheets
    If O.Name <> OD.Name Then
        COL = O.Index + 1
        For I = 7 To 77
            If O.Cells(I, "AC").Value <> 0 Then OD.Cells(I, COL).Value = O.Cells(I, "AC").Value
        Next I
    End If
Next O
End Sub

Wahou génial ! Cela fonctionne super bien ! Par contre je n'arrive pas à comprendre le code, pourrais-tu simplement m'expliquer brièvement le fonctionnement si cela ne te dérange pas ?

Encore une fois merci pour avoir résolu mon problème !

Je dois encore te déranger mais cela fonctionne sur mon exemple car j'ai supprimé les autres onglets qui ne sont pas des mois et cela ne fonctionne plus.. j'ai essayé d'attribuer des noms à ces fameux onglets mais ça ne change rien.

Quelle pourrait être la solution ?

Re,

Commence par renommer les onglets des mois avec les accents pour que Excel les reconnaisse : Février, Août, Décembre...

Puis ce nouveau code :

Private Sub CommandButton1_Click()
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim COL As Byte 'déclare la variable COL (COLonne)

Set OD = Worksheets("BILAN") 'définit l'onglet destination OD
For Each O In Worksheets 'boucle 1 : sur tous les onglets du classeur
    If O.Name <> OD.Name Then 'condition : si le nom de l'onglet de la boucle n'est pas le nom de l'onglet OD ("BILAN")
        Select Case O.Name 'agit en fonction du nom de l'onglet
            Case "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"
                'définit la colonne COL en fonction du nom de l'onglet de la boucle (le mois converti en entier Byte + 1)
                COL = CByte(Month("1/" & O.Name & "/2020")) + 1
                For I = 7 To 77 'boucle 2 : des lignes 7 à 77
                    'si la valeur de la cellule ligne I colonne AC de l'onglet de la boucle n'est pas vide,
                    'renvoie cette valeur dans la ligne I colonne COL de l'onglet OD
                    If O.Cells(I, "AC").Value <> 0 Then OD.Cells(I, COL).Value = O.Cells(I, "AC").Value
                Next I 'prochaine ligne de la boucle 2
            End Select 'fin de l'action en fonction du nom de l'onglet
    End If 'fin de la condition
Next O 'prochain onglet de la boucle 1
End Sub

Bonjour,

Super ce code fonctionne aussi ! J'ai trouvé une solution alternative aussi, j'ai mis des Dim Ox pour chaque onglet différent et utilisé des OR pour les IF. Cela implique donc de laisser dans l'ordre mes onglets mais cela fonctionne tout de même.

Encore merci pour ton aide, tu m'as de nouveau bien aidé !

Bonne journée.

Rechercher des sujets similaires à "copie valeurs lignes feuilles recapitulatif"