Sub calculdelais()
Application.ScreenUpdating = False
Dim Tablo() As Variant
Dim TabFinal() As Variant
With Sheets("Feuil1")
Tablo = .UsedRange.Value
End With
With Sheets("livraison")
.UsedRange.Clear
End With
NbCol = 2 * (UBound(Tablo, 2) - 4) + 4
ReDim TabFinal(1 To UBound(Tablo, 1), 1 To NbCol)
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
For j = LBound(Tablo, 2) To 4
TabFinal(i, j) = Tablo(i, j)
Next j
For j = 5 To UBound(Tablo, 2)
If i = 1 Then
jour = Split(Tablo(i, j), " ")(1)
TabFinal(i, 2 * j - 5) = DateSerial(2018, Split(jour, "/")(1), Split(jour, "/")(0)) 'les dates
Else
If Tablo(i, j) <> "" Then
TabFinal(i, 2 * j - 5) = Tablo(i, j)
TabFinal(i, 2 * j - 4) = TabFinal(1, 2 * j - 5) + Tablo(i, j) 'Format(WorksheetFunction.WorkDay(TabFinal(1, 2 * j - 5), TabFinal(i, 2 * j - 5)), "yyyy/mm/dd")
End If
End If
Next j
Next i
With Sheets("Livraison")
.Range("A1").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
'Mise en forme de la feuille
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A2:D2").Cut Destination:=.Range("A1:D1")
.Range("E1").FormulaR1C1 = "Com"
.Range("F1").FormulaR1C1 = "Livr"
.Range("E1:F1").AutoFill Destination:=.Range("E1").Resize(1, NbCol - 4), Type:=xlFillDefault
For i = 5 To NbCol Step 2
With .Cells(2, i).Resize(1, 2)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Next i
With .Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
.Columns("E").Resize(, NbCol - 5).ColumnWidth = 12
.UsedRange.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
Application.ScreenUpdating = True
End Sub