Fusion des données provenant de différents onglets

Bonsoir à tous,

Je suis encore tout jeune dans le domaine du VBA, mes compétences limitées et je bute sur certains points... Et je suis sûr que mon code peut être largement optimisé...

Par rapport à mon fichier Excel que vous trouverez en PJ, qui résume les actions CSE (Comité de Sécurité et d'Environnement) de mon entreprise, par différents onglets en fonction du mois, je souhaiterais fusionner ces données en un seul onglet "Recap" permettant une visualisation générale de toutes les actions via le bouton qui se trouve dans l'onglet "Recap".

Mon but étant d'arriver à la mise en page que vous trouverez dans l'onglet "Recap_souhait".

Cependant, je bloque sur le fait que je n'arrive pas à positionner les données de l'onglet suivant tout de suite après les données de l'onglet précédent. Il garde le nombre de lignes créer dans les différents onglets. Est-ce dû au fait que se soit sous forme de tableau ? Ce format est facile à travailler mais le nombre de lignes renseignées est variable et non connu en avance.

Enfin, j'ai également inséré une mise en page mais il ne prend pas en compte certaines valeurs. Par exemple, la largeur des colonnes "D", "E", "F" et "G" alors que les autres sont OK. Je ne parviens pas à savoir d'où vient l'erreur dans mon code.

Sub fusion()
'Fusionne tous les onglets en un seul appelé Recap
Dim dlgR As Integer, dlgi As Integer
Dim i As Byte
With Sheets("RECAP")
dlgR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:I" & dlgR).ClearContents
End With
For i = 4 To Worksheets.Count
        dlgR = Sheets("RECAP").Range("A" & Rows.Count).End(xlUp).Row
        With Sheets(i)
            dlgi = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A1:I" & dlgi).Copy Sheets("RECAP").Range("A" & dlgR + 1)
        End With
        Next
'Mise en forme des données de l'onglet Recap
    Columns("A:A").Select
    Selection.ColumnWidth = 5
    Columns("B:B").Select
    Selection.ColumnWidth = 17
    Columns("C:C").Select
    Selection.ColumnWidth = 17
    Columns("D:D").Select
    Selection.ColumnWidth = 17
    Columns("E:E").Select
    Selection.ColumnWidth = 17
    Columns("F:F").Select
    Selection.ColumnWidth = 78
    Columns("G:G").Select
    Selection.ColumnWidth = 62
    Columns("H:H").Select
    Selection.ColumnWidth = 13
    Columns("I:I").Select
    Selection.ColumnWidth = 37
    Range("F:G").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
End Sub

Merci d'avance pour le temps et l'aide apportée !!

Bonjour,

Voici un essai d'adaptation du code :

Sub fusion()

application.screenupdating = false
with Sheets("RECAP")

    dlgR = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:I" & dlgR).ClearContents
    for each ws in worksheets
        if ws.index > 3 then
            nvlR = .Range("A" & .Rows.Count).End(xlUp).Row + iif(ws.index = 4, 0, 1)
            dlgi = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            ws.Range("A1:I" & dlgi).Copy .Range("A" & nvlR)
        end if
    Next ws
   
    tcol = array(1, "B:E", 6,  7, 8, 9)
    twidth = array(5, 17, 78, 62, 13, 37)
    for i = lbound(tcol) to ubound(tcol)
        .Columns(tcol(i)).ColumnWidth = twidth(i)
    next i

    With .Range("F:G")
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    end with
end with
application.screenupdating = true

End Sub

Cdlt,

Bonjour,

Une approche avec une solution Power Query.

Cdlt.

Bonsoir Jean-Eric et 3GB,

Merci pour vos réponses, Jean-Eric, je ne connais pas Power Query et déjà que l'utilisation des macros est encore limité pour moi, je ne souhaite pas me lancer dans un nouveau domaine...

3GB, ta solution me convient parfaitement !

Merci à vous 2.

Cdlt

Bonsoir Alweax,

Super ! Merci du retour et bonne soirée !