Synthèse plusieurs fiches projet

Bonjour,

Je suis novice en VBA et je sollicite votre expertise en la matière .

Je vais essayer d'etre clair, j'ai un fichier (cf exemple) qui contient un nombre important d'onglet (fiche projet).

Je souhaite dans l'onglet SYNTHESE "en 1 clic" faire une mise a jour du tableau structuré comme suit :

• Dans la première colonne générer un lien hypertexte vers chaque onglet
• Dans les colonnes suivantes faire juste un copier/coller de certaines cellule de la fiche projet (en rouge)

Est ce faisable facilement? Pouvez vous m'aider?

Merci d'avance

Bonjour à tous,

Je n'y connais pas grand chose en VBA mais je fouine un peu a droite a gauche et je vais préciser ma demande sur le tableau final que je souhaite :

Dans la première colonne générer un lien hypertexte vers chaque onglet

Utilisation du code suivant sans générer une feuille vierge mais seulement les liens dans la colonne A vers chaque feuille (Tous cela dans "SYNTHESE")

Sub creerSommaire() If Worksheets(1).Name = "SOMMAIRE" Then Application.DisplayAlerts = False Worksheets(1).Delete Application.DisplayAlerts = True End If Sheets.Add before:=Worksheets(1) ActiveSheet.Name = "SOMMAIRE" [a1] = "SOMMAIRE DU CLASSEUR :" Dim ligne As Integer ligne = 3 Dim feuille As Worksheet For Each feuille In Worksheets ActiveSheet.Hyperlinks.Add anchor:=Cells(ligne, 1), Address:="", SubAddress:="'" & feuille.Name & "'!A1", TextToDisplay:=feuille.Name ligne = ligne + 1 Next End Sub

Dans les colonnes suivantes faire juste un copier/coller de certaines cellule de la fiche projet (en rouge)

Plus précisément, je souhaite coller :

• La cellule D7 de chaque fiche dans la colonne B

• La cellule F19 de chaque fiche dans la colonne C

• La cellule F20 de chaque fiche dans la colonne D

• La cellule F21 de chaque fiche dans la colonne E

• La cellule F22 de chaque fiche dans la colonne F

• La cellule D13 de chaque fiche dans la colonne G

Je souhaiterai utiliser un code dans ce genre là mais je n'arrive pas à définir la colonne de destination :

Sub synthese() Application.ScreenUpdating = False Dim colDep, colFin, ligDep, ligFin, ligExport Dim WsSynth As Worksheet, Ws As Worksheet 'Initialisation de variables colDep = "d" colFin = "d" ligDep = 7 ligFin = 7 Set WsSynth = Sheets("SYNTHESE") 'Réinitialisation de la feuille de synthèse ligExport = WsSynth.Range("a" & Rows.Count).End(xlUp).Row + 1 WsSynth.Range(colDep & 4, colFin & ligExport) = "" ligExport = 2 'Import des données de synthèse For Each Ws In ThisWorkbook.Worksheets If LCase(Ws.Name) <> "synthese" Then For i = ligDep To ligFin If Ws.Range("b" & i) <> "" And Ws.Range("b" & i) <> 0 Then WsSynth.Range(colDep & ligExport, colFin & ligExport).Value = _ Ws.Range(colDep & i, colFin & i).Value ligExport = ligExport + 1 End If Next i End If Next Ws Application.ScreenUpdating = True End Sub

Je pense être sur la bonne voie mais il me faut un peu d'aide pour finaliser

Merci d'avance pour tout

Bonjour,

Essaie ainsi :

Sub Macro1()
Dim Sh As Worksheet, ShSomm As Worksheet
Dim Lig As Long
Dim Cel As Range
Set ShSomm = Sheets("SYNTHESE")
With ShSomm
    .Range("A3:G200").ClearContents
    For Each Sh In Worksheets
        If Sh.Name <> .Name And Sh.Name <> "Modèle" Then
            Lig = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            Set Cel = .Cells(Lig, "A")
            .Hyperlinks.Add Anchor:=Cel, Address:="", SubAddress:="'" & Sh.Name & "'!A1", TextToDisplay:=Sh.Name
            Cel.Offset(, 1).FormulaR1C1 = "='" & Sh.Name & "'!R7C4"
            Cel.Offset(, 2).FormulaR1C1 = "='" & Sh.Name & "'!R19C6"
            Cel.Offset(, 3).FormulaR1C1 = "='" & Sh.Name & "'!R20C6"
            Cel.Offset(, 4).FormulaR1C1 = "='" & Sh.Name & "'!R21C6"
            Cel.Offset(, 5).FormulaR1C1 = "='" & Sh.Name & "'!R22C6"
            Cel.Offset(, 6).FormulaR1C1 = "='" & Sh.Name & "'!R13C4"
        End If
    Next Sh
End With

Peut-être?

Hello,

Merci cousinhub pour ton aide. J'ai testé mais cela me génère beaucoup trop de ligne, il doit y avoir des doublons.

Entre-temps je m'en suis sorti avec le code ci-dessous et cela me convient parfaitement

Sub synthese() Application.ScreenUpdating = False Dim colDep, colFin, ligDep, ligFin, ligExport Dim WsSynth As Worksheet, Ws As Worksheet Dim ligne As Integer ligne = 3 'Lien Hypertexte For Each Ws In ThisWorkbook.Worksheets If LCase(Ws.Name) <> "synthese" Then ActiveSheet.Hyperlinks.Add anchor:=Cells(ligne, 1), Address:="", SubAddress:="'" & Ws.Name & "'!A1", TextToDisplay:=Ws.Name ligne = ligne + 1 End If Next 'Initialisation de variables colDep = "D" colFin = "D" ligDep = 7 ligFin = 7 colArr = "B" colRaz = "G" Set WsSynth = Sheets("SYNTHESE") 'Réinitialisation de la feuille de synthèse ligExport = WsSynth.Range("a" & Rows.Count).End(xlUp).Row + 1 WsSynth.Range(colArr & 3, colRaz & ligExport) = "" ligExport = 3 'Import des données de synthèse For Each Ws In ThisWorkbook.Worksheets If LCase(Ws.Name) <> "synthese" Then For i = ligDep To ligFin If Ws.Range("b" & i) <> "" And Ws.Range("b" & i) <> 0 Then WsSynth.Range(colArr & ligExport, colArr & ligExport).Value = _ Ws.Range(colDep & i, colFin & i).Value ligExport = ligExport + 1 End If Next i End If Next Ws

Bonjour,

J'utilise mon fichier depuis qques temps et pour plus de fluidité je dois légèrement en modifier le format.

Du coup je me retrouve avec un problème, je dois coller les données d'une cellule fusionnée vers une cellule non fusionnée mais je ne vois pas comment.

Le code sur le post du dessus ne fonctionne pas avec des cellules fusionnées.

Quelqu'un a une idée?

Merci d'avance de votre aide