1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
| 'mise en page: defusioner et remplir les cases et replacer les titres
Sheets("Planning").Activate
Dim MergedCell As Range
Dim FirstAddress As String
Dim MergeAddress As String
Dim MergeValue As Variant
Application.FindFormat.MergeCells = True
Do
Set MergedCell = ActiveSheet.Range("U:U").Find("", LookAt:=xlPart, SearchFormat:=True)
If MergedCell Is Nothing Then Exit Do
MergeValue = MergedCell.Value
MergeAddress = MergedCell.MergeArea.Address
MergedCell.MergeArea.UnMerge
Range(MergeAddress).Value = MergeValue
Loop
Application.FindFormat.Clear
'séparer les "MODE"
Dim Lign As Long
Dim Plage As String
Dim I As Long, nbLignes As Long
nbLignes = Cells(Rows.Count, "D").End(xlUp).Row
Sheets("Expéditions").Select
Lign = 22
For Lign = 22 To 50
If Cells(Lign, 5).Value <> Cells(Lign + 1, 5).Value Then
Lign = Lign + 1
Plage = Lign & ":" & Lign
Rows(Plage).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next |
Partager