Re : Incrémentation et Copie Colonne De La Feuille Précédente
bonjour,
Essaie ce code :
Sub NewMonth_Sheet()
Dim lSht As Worksheet
Dim nSht As Worksheet
Dim shName As String
Dim Cel As Range, I As Long
Set lSht = Sheets(Sheets.Count)
a = lSht.Name
If IsDate(lSht.Name) Then
shName = Application.Proper(Format(DateAdd("m", 1, lSht.Name), "mmmm-yyyy"))
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next 'Tests that sheet doesn't already exist
Set nSht = Sheets(shName)
On Error GoTo 0
Sheets("Total Général").Activate
Range("D" & Cells(Rows.Count, 4).End(xlUp).Row - 1).EntireRow.Copy
Range("A" & Cells(Rows.Count, 4).End(xlUp).Row).EntireRow.Insert Shift:=xlDown
Application.CutCopyMode = False
If nSht Is Nothing Then
lSht.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = shName
Else
MsgBox "Sheet """ & shName & """ already exists!", vbCritical
End If
Else
MsgBox "Last sheet name does not" & Chr(10) & "represent a month!", vbCritical: Exit Sub
End If
For I = 35 To 9 Step -1
If IsDate(Cells(I, "E").Value) Then Cells(I, "E").EntireRow.Delete
Next I
Sheets(a).Select
Range("J9:J34").Select
Selection.Copy
Sheets(shName).Select
Sheets(shName).Select
Range("H9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
a+