Sub Titre_CMDP()
Dim derlig As Long, DerCol As Long
Dim Tp
Dim Ind As Byte
Application.ScreenUpdating = False
Tp = Array("A", "B", "C")
For Ind = 0 To 2
With Worksheets(Tp(Ind))
DerCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
derlig = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Select Case Ind
Case 0 'pour feuilleA
.Range("A1") = "Région"
.Range("B1") = "RAPPORT CONCERNANT A"
.Cells(1, DerCol + 6) = Sheets("données").Range("A1")
.Cells(1, DerCol + 5) = "Date:"
Case 1, 2 'pour feuilles B et C
.Range("A1") = "Région"
.Range("B1") = "RAPPORT CONCERNANT BC"
.Cells(1, DerCol) = Sheets("données").Range("A1")
.Cells(1, DerCol - 1) = "Date:"
If derlig > 5 Then HauteurCelluleFusionnée .Range("A6:A" & derlig)
End Select
' If derlig > 5 Then HauteurCelluleFusionnée .Range("A6:A" & derlig)
End With
Next Ind
MsgBox "Terminé!"
End Sub
Sub HauteurCelluleFusionnée(plage As Range)
Dim c As Range, ma As Range
Application.ScreenUpdating = False
For Each c In plage
Set ma = c.MergeArea
If ma.Count > 1 And c <> "" Then
ma.UnMerge
c.Rows.AutoFit 'ajustement automatique
ma.Rows.RowHeight = (c.RowHeight + 5) / ma.Count 'hauteurs égales
ma.Merge
End If
Next
End Sub