Récapitulatif automatique de contenu de cellules

Bonjour à tous, j'ai découvert le VBA depuis peu, j'ai beaucoup utilisé les ligne de code trouvées sur le web, je suis au stade où ça ne m'aide plus, du coup je tente de dévellopper un code adapté à mes besoin, j'avoue toutefois faire un peu de tir au pigeon très chronophage. J'en viens à demander votre aide.

Pour faire un récapitulatif des données des feuilles d'un classeur (dates), je souhaite remplir une plage de donnée sur une feuille 'Planning' avec le contenu de cellules (C80:T80) de toutes les feuilles de ce classeur, ainsi que des données des feuilles qui seront créées ultérieurement.

J'ai fait des centaines d'essais mais j'ai clairement pas compris les boucles ni les variables, (sans les if, msgbox et autres) :

Merci d'avance

Sub datesPlanning

    Dim feuille As Worksheet, nomchantier As string, numchro As integer

       nomchantier = ActiveSheet.Name

       numchro = Range("C80:T80")

 For Each feuille In Worksheets

    Sheets("nomchantier").Range("numchro") = Sheets("lienplanning")

    nomchantier = nomchantier + 1

 Next

 End Sub

Bonjour Manu, le forum

Voici un code basique qui fait ce que tu souhaites.

Sub datesPlanning()
Dim feuille As Worksheet, Derligne As Integer
Derligne = Sheets("lienplanning").Range("A" & Rows.Count).End(xlUp).Row + 1

     For Each feuille In Worksheets 
        If feuille.Name <> "lienplanning" Then
            feuille.Range("C80:T80").Copy
            Sheets("lienplanning").Select
            Range("A" & Derligne & ":T" & Derligne).Select
            ActiveSheet.Paste
            Derligne = Derligne + 1
        End If
    Next

End Sub

Si tu veux des explications , n'hesite pas.

Et aussi, quand tu crées un sujet sur ce forum, tu auras beaucoup plus de chances de te faire aider si tu joins un fichier.

Cdlt

Bonjour,
Une autre proposition.
Cdlt.

Public Sub ConsolidateData()
Dim wb As Workbook
Dim ws As Worksheet, wsData As Worksheet
Dim rng As Range
Dim lastRow As Long
Const R As String = "C80:T80"

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("lienplanning")

    For Each ws In wb.Worksheets
        Select Case ws.Name
            Case "lienplanning":
            Case Else:
                Set rng = ws.Range(R)
                With wsData
                    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(lastRow, 1).Resize(, 18).Value = rng.Value
                End With
        End Select
    Next ws

End Sub

Bonjour Le forum, j'ai bien compris, ça marche très bien merci beaucoup !!!

Bonjour Jean-eric, j'ai pas compris tout de suite, un peu plus dur à comprendre, mais ça trés bien aussi, merci beaucoup aussi !!

A bientôt, votre forum est incroyable !!

Salut à tous, finalement, j'ai encore un problème avec ce code:

Les valeurs de mes cellules surces font appel à d'autres cellules ex: dans la cellule C80 j'ai =N4, du coup sur ma feuille récap je n'ai que des href!

J'ai essayé plein de choses rien ne marche et la copie cellule par cellule, ... j'y suis pas arrivé:

(je crois que le codage vba c'est un métier, mais j'essaie quand même)

Sub datesPlanning()

 Sheets("lienplanning").Activate Sheets("lienplanning").Cells.Select

 Sheets("lienplanning").Cells.Delete

 Dim feuille As Worksheet, Derligne As Integer, Dercolone As Integer

     Derligne = Sheets("lienplanning").Range("A" & Rows.Count).End(xlUp).Row + 1 '

     Dercolone = Sheets("lienplanning").Range(Columns.Count & Derligne).End(xlUp).Column + 1

For Each feuille In Worksheets

   If feuille.Name <> "lienplanning" Or feuille.Name <> "sommaire" Then

     feuille.Range("N4").Copy Sheets("lienplanning").Select

     Range(Dercolone & Derligne).Select

     ActiveSheet.Paste

        Derligne = Derligne + 1

        Dercolone = Dercolone + 1

 End If

 Next

'Puis j'essaie pour une autre cellule:

 For Each feuille In Worksheets

   If feuille.Name <> "lienplanning" Or feuille.Name <> "sommaire" Then

      feuille.Range("H53").Copy

      Sheets("lienplanning").Select

      Range(Dercolone & Derligne).Select

      ActiveSheet.Paste

        Derligne = Derligne + 1

        Dercolone = Dercolone + 1

   End If

 Next

 End Sub