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
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