Suite de macro

Bonsoir à tous.

Voilà je souhaiterais ouvrir un fichier et lancer une macro regroupant plusieurs macros.

Je 'm'explique j'ai ces deux macro que j 'exécute une par une.

Option Explicit

Sub Supprimer_Lignes_Vides()

' Lignes Vides sur la Base de la Colonne F'

Application.ScreenUpdating = False

Dim der As Long

der = Feuil1.Cells(Rows.Count, 5).End(xlUp).Row + 1

Range("N3") = "Test"

Range("N4").FormulaR1C1 = "=COUNTA(RC[-13]:RC[-1])"

Range("N4").Copy Destination:=Range("N5:N" & der)

With Feuil1.Range("B3:N" & der)

.AutoFilter field:=13, Criteria1:="0"

.Offset(1, 0).EntireRow.Delete

.AutoFilter

End With

Columns("N:N").Delete Shift:=xlToLeft

Application.ScreenUpdating = True

End Sub

Sub Defusionne()

Dim i&

Application.ScreenUpdating = False

With Feuil1 'CodeName

With .Range("A1", .UsedRange)

For i = 7 To .Rows.Count

With .Cells(i, 2).MergeArea

If Not .Font.Bold And .Count > 1 Then .UnMerge: .Value = .Cells(1)

End With

With .Cells(i, 3).MergeArea

If Not .Font.Bold And .Count > 1 Then .UnMerge: .Value = .Cells(1)

End With

Next

End With

End With

End Sub

Ensuite je souhaiterais supprimer les lignes fusionnées du type ligne 4/5 7/8 etc et de rajouter 3 colonnes D E F pour obtenir un resultat comme dans l'onglet 2.

Est-ce qu'une personne pourrait me refaire mon fichier? En ayant un bouton qui fait tout ça ce serait le top.

Merci bien

Bonsoir

Essayez avec ce code

Sub test()
'Dan
Dim der As Integer, i As Integer
Application.ScreenUpdating = False
With Feuil1 'CodeName
    der = .Cells(.Rows.Count, 5).End(xlUp).Row
    .Range("B3:G" & der).UnMerge
    .Columns(4).Resize(, 3).Insert Shift:=xlToRight
    .Cells(3, 4) = "Zone Logistique"
    .Cells(3, 5) = "Zone magasin"
    .Cells(3, 6) = "Réservation logistique"
    For i = 4 To der
        If .Cells(i, 2).Font.Bold Then
            .Range(.Cells(i, 2), .Cells(i, 8)).Merge
            .Range(.Cells(i, 2), .Cells(i, 8)).HorizontalAlignment = xlCenter
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

Cordialement

Merci