Macro ou formule pour afficher le contenu de cellules

Bonjour,

Il s'agit de ma première visite sur ce Forum, ainsi que sur ce site.

J'ai tenté de solutionner le problème auquel je suis confronté, mais en vain. Je pense qu'il me faudrait une bonne formation qui demanderait un temps que je ne possède pas actuellement.

Soit, voici le problème auquel je suis confronté et pour lequel je fais appel à votre aide:

Je dispose d'un fichier Excel contenant 400 feuilles, soit une feuille par client.

Chaque mois, j'ai besoin d'extraire le contenu de quelques cellules présentes au même endroit sur chaque feuille.

Actuellement, cette extraction est réalisée manuellement, et je suis certain que l'on peut automatiser cette procédure, mais je ne suis pas du tout expert en vba...

Voici le fichier en pièce-jointe, j'ai volontairement supprimé 390 feuilles car il était trop volumineux.

J'aimerais pouvoir créer un tableau de synthèse qui afficherait le contenu des cellules B1 G1 L1 et B15, le tout sur la même ligne, et donc avec une ligne pour chaque feuille.

J'espère que quelqu'un pourra m'aider

Merci d'avance.

Bonjour

Pour commencer, je pense que la fusion des champs contenant les infos à récupérer n'est pas du tout exploitable, en tout cas de façon simple.

A voir donc,,,,,, je planche ......

Effectivement, cela je ne l'avais même pas envisagé.

Serait-il possible pour faire plus simple d'afficher une synthèse reprenant sur la même ligne le nom de la feuille et juste à coté le contenu de la cellule B15 et d'afficher ceci sur ligne pour chaque feuille ?

Merci beaucoup.

Bonjour

C'est bien B15 (pour payé en février) que tu veux?

Cordialement

Oui c'est bien cela.

Salut,

Sub synthèse()
Dim i As Integer
Dim Sh
Dim Cas As Boolean

Cas = False

For Each Sh In ActiveWorkbook.Sheets
    If Cas = False Then
        If Sh.Name = "Synthèse" Then
        Cas = True
        End If
    End If
Next Sh

If Cas = False Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Synthèse"
    i = 1
Else
    i = Sheets("Synthèse").UsedRange.Rows.Count
End If

For Each Sh In ActiveWorkbook.Sheets
    If Sh.Name <> "Vierge ok" And Sh.Name <> "CHARGES" And Sh.Name <> "Synthèse" Then

        Sh.Activate
        Sh.Range("B1").Copy
        Sheets("Synthèse").Activate
        ActiveSheet.Paste Destination:=ActiveSheet.Range("A" & i)

        Sh.Activate
        Sh.Range("G1").Copy
        Sheets("Synthèse").Activate
        ActiveSheet.Paste Destination:=ActiveSheet.Range("B" & i)

        Sh.Activate
        Sh.Range("L1").Copy
        Sheets("Synthèse").Activate
        ActiveSheet.Paste Destination:=ActiveSheet.Range("C" & i)

        Sh.Activate
        Sh.Range("B15").Copy
        Sheets("Synthèse").Activate
        ActiveSheet.Paste Destination:=ActiveSheet.Range("D" & i)

        i = i + 1
    End If
Next Sh
Columns("A:A").Select
ActiveSheet.Range("A:BA").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

Wouah,

un grand merci nono78, c'est tout simplement génial !

Bonjour le forum, bonjour l'équipe,

voici ton fichier!

Evidemment, il faudra prévoir un peu plus loin que [B15] à l'avenir!

Private Sub cmdGO_Click()
'
Dim tTab()
'
Application.ScreenUpdating = False
'
Range("A4").Resize(UsedRange.Rows.Count, 4).ClearContents
For x = 1 To Sheets.Count
    If Sheets(x).Name <> "SYNTHESE" And Sheets(x).Name <> "CHARGES" And Sheets(x).Name <> "Vierge ok" Then
        iIdx = iIdx + 1
        ReDim Preserve tTab(4, iIdx)
        With Sheets(x)
            tTab(0, iIdx - 1) = .[B1]
            tTab(1, iIdx - 1) = .[G1]
            tTab(2, iIdx - 1) = .[L1]
            tTab(3, iIdx - 1) = .[B15]
        End With
    End If
Next
Range("A4").Resize(iIdx, 4) = WorksheetFunction.Transpose(tTab)
Range("A4").Resize(UsedRange.Rows.Count, 4).Sort key1:=Range("A4"), order1:=xlAscending, Orientation:=xlTopToBottom
Columns("A:D").AutoFit
'
Application.ScreenUpdating = True
'
End Sub

Un petit bouton rouge en 'SYNTHESE'...

A+

7locataires.xlsm (108.26 Ko)

Bonjour

autre

Sheets("Synthèse").Activate
    For i = 1 To Worksheets.Count - 3
         [A1].Offset(i, 0).Value = Worksheets(i).Name
    Next i
    Range("a2", Range("a2").End(xlDown)).Offset(0, 1).FormulaR1C1 = "=INDIRECT(""'""&RC1&""'!B1"")"
    Range("a2", Range("a2").End(xlDown)).Offset(0, 2).FormulaR1C1 = "=INDIRECT(""'""&RC1&""'!G1"")"
    Range("a2", Range("a2").End(xlDown)).Offset(0, 3).FormulaR1C1 = "=INDIRECT(""'""&RC1&""'!L1"")"
    Range("a2", Range("a2").End(xlDown)).Offset(0, 4).FormulaR1C1 = "=INDIRECT(""'""&RC1&""'!B15"")"
    Range("A2:E" & [A65000].End(xlUp).Row).Select
        Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("a1").Select
End Sub

Tu cliques sur le Bouton de la feuille Synthèse

Cordialement

Merci beaucoup à toutes les personnes qui ont apporté leur solutions.

Je viens de tester la première, qui fonctionne déjà fort bien, mais je vais toutes les essayer.

Cordialement,

Bonjour,

Avec un peu de retard. (problèmes FAI).

Une autre proposition avec le choix du mois à consolider.

Cdlt.

Bonsoir à tous, Win4lucio,

ce à quoi je pensais en parlant d'avenir : l'affichage de tous les mois de l'année avec le mois en cours à gauche. 8)

Bonne continuation!

A+

9locataires.xlsm (112.99 Ko)

Bonjour,

Encore merci pour votre aide, cela va me faire gagner un temps précieux, et me donne envie d'apprendre ...

@ ++

Rechercher des sujets similaires à "macro formule afficher contenu"