Microsoft 365 Fusionner tous ces onglet en 1 seul

[Erakmur]

Bonjour,
Dans le fichier joint, quelqu'un peut il créer un onglet qui fusionne tous les onglets en 1 seul en respectant la mise en page et l'ordre d'apparition des onglets dans le fichier ?
Cordialement

 

[Erakmur]

Re,
Ce serait étonnant que cette feuille soit compatible de votre feuille fusionnée. Ne serait ce qu'à cause des shapes.
Peut être serait il bien de nous fournir un fichier type qu'attend votre outil tiers.

J'avais besoins que tous les onglets soient fusionnés pour commencer à travailler dessus. Se n'est que la première étape de la transformation

 

[vgendron]

hello

avant de rajouter des colonnes
1) il faut que tu modifies les tableau pour qu'il y ait les memes colonnes "H M T S A SD" sur TOUTES les lignes
==> ca veut dire qu'il faut modifier le code pour harmoniser tout ca
==> ou alors te taper l'insertion de la colonne H manquante sur toutes les "sections"

2) ensuite, tu pourras utiliser UNE formule unique sur toute la colonne
genre :

=SI(H4="X";$H$3;"")&SI(I4="X";$I$3;"")&SI(J4="X";$J$3;"")&SI(K4="X";$K$3;"")&SI(L4="X";$L$3;"")&SI(M4="X";$M$3;"")

mais on peut se passer de la formule pour faire tout ca par macro..

mais bon.. comme je sens que tu vas donner toutes les étapes au compte goutte, on a pas fini de modifier
ne pourrais tu pas donner l'allure finale du fichier qu'il te faut pour que ton logiciel soit capable de travailler??

 

[vgendron]

Sub Fusion()
Dim F, DL%, DL2%, N%
Dim TabData() As Variant
Nettoyage
SuppFeuillesMasquées
Application.ScreenUpdating = False
For Each F In Worksheets
    If F.Name <> "Synthèse" Then
        N = N + 1
        With Sheets(F.Name)
            DL = Application.Max( _
                1 + Cells(Rows.Count, "A").End(xlUp).Row, _
                1 + Cells(Rows.Count, "B").End(xlUp).Row)
            DL2 = Application.Max( _
                1 + .Cells(Rows.Count, "A").End(xlUp).Row, _
                1 + .Cells(Rows.Count, "B").End(xlUp).Row)
             TabData = .Range("H2:P" & DL2).Value
            
             For i = LBound(TabData, 1) To UBound(TabData, 1)
                For j = LBound(TabData, 2) To UBound(TabData, 2) - 2
                    If TabData(i, j) <> "" Then TabData(i, 9) = TabData(i, 9) & TabData(1, j)
                Next j
             Next i
            .Range("A1:N" & DL2).Copy
            Cells(DL, "A").Select
            ActiveSheet.Paste
            Cells(DL + 1, "H").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData
            Application.CutCopyMode = False
        End With
    End If
Next F
Application.ScreenUpdating = True
MsgBox Masqué & " feuilles masquées ont été supprimées." & Chr(10) & N & " feuilles fusionnées"
End Sub

 

[vgendron]

mieux ici

Sub Fusion()
Dim F, DL%, DL2%, N%
Dim TabData() As Variant
Nettoyage
SuppFeuillesMasquées
Application.ScreenUpdating = False
For Each F In Worksheets
    If F.Name <> "Synthèse" Then
        N = N + 1
        With Sheets(F.Name)
            DL = Application.Max( _
                1 + Cells(Rows.Count, "A").End(xlUp).Row, _
                1 + Cells(Rows.Count, "B").End(xlUp).Row)
            DL2 = Application.Max( _
                1 + .Cells(Rows.Count, "A").End(xlUp).Row, _
                1 + .Cells(Rows.Count, "B").End(xlUp).Row)
             TabData = .Range("H2:P" & DL2).Value
            
             For i = LBound(TabData, 1) To UBound(TabData, 1)
                j = 1
                While TabData(1, j) <> "Commentaires"
                'For j = LBound(TabData, 2) To UBound(TabData, 2) - 2
                    If TabData(i, j) <> "" Then TabData(i, 9) = TabData(i, 9) & TabData(1, j)
                    j = j + 1
                'Next j
                Wend
             Next i
            .Range("A1:N" & DL2).Copy
            Cells(DL, "A").Select
            ActiveSheet.Paste
            Cells(DL + 1, "H").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData
            Application.CutCopyMode = False
        End With
    End If
Next F
Application.ScreenUpdating = True
MsgBox Masqué & " feuilles masquées ont été supprimées." & Chr(10) & N & " feuilles fusionnées"
End Sub

 

[Erakmur]

mieux ici

Sub Fusion()
Dim F, DL%, DL2%, N%
Dim TabData() As Variant
Nettoyage
SuppFeuillesMasquées
Application.ScreenUpdating = False
For Each F In Worksheets
    If F.Name <> "Synthèse" Then
        N = N + 1
        With Sheets(F.Name)
            DL = Application.Max( _
                1 + Cells(Rows.Count, "A").End(xlUp).Row, _
                1 + Cells(Rows.Count, "B").End(xlUp).Row)
            DL2 = Application.Max( _
                1 + .Cells(Rows.Count, "A").End(xlUp).Row, _
                1 + .Cells(Rows.Count, "B").End(xlUp).Row)
             TabData = .Range("H2:P" & DL2).Value
           
             For i = LBound(TabData, 1) To UBound(TabData, 1)
                j = 1
                While TabData(1, j) <> "Commentaires"
                'For j = LBound(TabData, 2) To UBound(TabData, 2) - 2
                    If TabData(i, j) <> "" Then TabData(i, 9) = TabData(i, 9) & TabData(1, j)
                    j = j + 1
                'Next j
                Wend
             Next i
            .Range("A1:N" & DL2).Copy
            Cells(DL, "A").Select
            ActiveSheet.Paste
            Cells(DL + 1, "H").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData
            Application.CutCopyMode = False
        End With
    End If
Next F
Application.ScreenUpdating = True
MsgBox Masqué & " feuilles masquées ont été supprimées." & Chr(10) & N & " feuilles fusionnées"
End Sub

Bonjour, j'y suis arrivé tout seul. C'est pour cela que j'ai supprimé mon poste. Je n'ai pas insérer des colonnes pour y arriver. Comme les colonnes avec des H ne représente qu'une toute petite partie de la synthèse, je les aient traités à la mains. J'ai tous considéré avec M,T,S,A et j'ai traité le H avant M à la main après