Sub sup()
'
dl = Range("A65000").End(xlUp).Row
Dim Ws As Worksheet
Dim oldCalculation As XlCalculation
oldCalculation = Application.Calculation 'retenir le mode de calcul en cours
'Figer les éléments d'application chronophages
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For Each Ws In ActiveWorkbook.Worksheets
With Ws
.Name = "Lager"
With .Sort
.SortFields .Clear
.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1:A" & dl)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Next Ws
With ActiveSheet
lig = .Cells.Find(What:="*VERTEILER*", LookIn:=xlValues).Row
.Rows("2:" & lig).EntireRow.Delete
.Range("A1") = "ARTIKEL MENGE W-LG LGM-NR/ART PLATZ DATUM LS/SER/STK-B WAQS..PLI. G V"
.Range("A1:A" & dl).TextToColumns Destination:=Range("A1"), _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(14, 1), Array(23, 1), Array(28, 1), Array(39, 2), _
Array(45, 4), Array(52, 1), Array(65, 1), Array(70, 1)), TrailingMinusNumbers:=True
.Columns("I:I").Delete Shift:=xlToLeft
With .Range("A1:A" & dl)
.Replace " ", "", xlValues, xlByRows, False
.Replace "/", "", xlValues, xlByRows, False
Next
.Range("I2:I" & dl).Formula = "=+DATE(YEAR(F2),MONTH(F2)+6,DAY(F2))<TODAY()"
End With
'Remettre les paramètres application à leur état initial
Application.Calculation = oldCalculation
Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.Calculate
ActiveWorkbook.SaveAs Filename:="C:\Temp\Start_lager.xls"
End Sub