Microsoft 365 Suite de macro

Moreno076

XLDnaute Impliqué
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
 

Pièces jointes

  • TEST.xlsm
    67 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
312 102
Messages
2 085 303
Membres
102 857
dernier inscrit
Nony1931