Sub PrepaEcheancier()
'
' PrepaEcheancier Macro
Dim DligE As Long, Lig As Long
Dim Nextlig As Long
Dim NSht As String, VDate As Date, Délai As String
Dim ShtE As Worksheet
Dim NbLToInsert As Integer
Sheets("ECHEANCIER").Select
' Définir la feuille échéancier
Set ShtE = Sheets("ECHEANCIER")
' Récupéer la dernière ligne
DligE = ShtE.Range("C" & Rows.Count).End(xlUp).Row
Range("M2:M" & DligE).Copy Destination:=Range("L2") 'on recopie la colonne M en L
For Lig = 2 To DligE
If ShtE.Range("L" & Lig).Value = "x" Then
Délai = ShtE.Range("A" & Lig).Value
NSht = ShtE.Range("B" & Lig).Value
With Sheets(NSht)
Nextlig = .Range("B" & Rows.Count).End(xlUp).Row
'inserer une ligne ici !!
.Rows(Nextlig).Copy
.Rows(Nextlig).Insert Shift:=xlShiftDown
Application.CutCopyMode = False
.Range("A" & Nextlig + 1).Value = ShtE.Range("C" & Lig).Value
.Range("E" & Nextlig + 1).Value = ShtE.Range("E" & Lig).Value
.Range("F" & Nextlig + 1).Value = ShtE.Range("F" & Lig).Value
.Range("B" & Nextlig + 1).Value = ShtE.Range("H" & Lig).Value
.Range("C" & Nextlig + 1).Value = ShtE.Range("D" & Lig).Value
If ShtE.Range("G" & Lig).Value <> "" Then 'ce test ne sert à rien !
.Range("G" & Nextlig + 1).Value = ShtE.Range("G" & Lig).Value
Else
.Range("G" & Nextlig + 1).Value = ShtE.Range("G" & Lig).Value
End If
End With
Select Case Délai
Case "Tous les mois"
VDate = ShtE.Range("C" & Lig).Value
ShtE.Range("C" & Lig).Value = DateAdd("m", 1, VDate)
Case "Tous les 3 mois"
VDate = ShtE.Range("C" & Lig).Value
ShtE.Range("C" & Lig).Value = DateAdd("m", 3, VDate)
'Case "Autes jours du mois"
' VDate = ShtE.Range("C" & Lig).Value
'ShtE.Range("C" & Lig).Value = DateAdd("m","d"; 1, VDate)
'Case "Tous les ans"
'VDate = ShtE.Range("C" & Lig).Value
'ShtE.Range("C" & Lig).Value = DateAdd("y", 1, VDate)
End Select
ShtE.Range("L" & Lig).ClearContents
End If
Next Lig
' RangeCompte Macro
Sheets("Compte").Activate
Range("A4:O" & Nextlig + 1).Select
ActiveWorkbook.Worksheets("Compte").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Compte").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Compte").Sort
.SetRange Range("A4:O" & Nextlig + 1)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'première ligne vide
Sheets("Compte").Select
Range("A1").End(xlDown).Offset(1, 0).Select
End Sub