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 39 40 41 42 43 44
| 'Si le nombre de ligne est supérieure à 12 (11 lignes + ligne de titre, découpage en deux tableaux
If NoLigne - FirstLigne > 11 Then
'Mettre le titre sur le deuxième tableau
Range(Cells(FirstLigne, 1), Cells(FirstLigne, ColFinCumul)).Select
Selection.Copy Destination:=Cells(FirstLigne, ColFinCumul + 4)
'Copie des lignes supérieur à 11
Range(Cells(FirstLigne + 12, 1), Cells(NoLigne - 1, ColFinCumul)).Select
Selection.Cut Destination:=Cells(FirstLigne + 1, ColFinCumul + 4)
'Sortie du mode de copie
Application.CutCopyMode = False
'Supprimer les lignes vides
Rows((FirstLigne + 12) & ":" & (NoLigne - 1)).Delete Shift:=xlUp
NbLigneTotal = NbLigneTotal - ((NoLigne - 1) - (FirstLigne + 12)) - 1
NoLigne = NoLigne - ((NoLigne - 1) - (FirstLigne + 12)) - 1
NoLigneTab2 = FirstLigne
While NoLigneTab2 <= 12 + FirstLigne
'Sélectionner le texte défusionner
Range(Cells(NoLigneTab2, ColFinCumul + 4), Cells(NoLigneTab2, ColFinCumul + 3 + LargMotif)).MergeCells = False
'Décaler de deux colonnes sur la gauche
Cells(NoLigneTab2, ColFinCumul + 4).Select
Selection.Cut Destination:=Cells(NoLigneTab2, ColFinCumul + 2)
'Fusionner les 8 colonnes
Range(Cells(NoLigneTab2, ColFinCumul + 2), Cells(NoLigneTab2, ColFinCumul + 3 + LargMotif)).MergeCells = True
'Traiter les lignes vides du tableau (fusions)
If Cells(NoLigneTab2, ColFinCumul + 4 + LargMotif).MergeCells = False Then
'Nombre d'heures
Range(Cells(NoLigneTab2, ColFinCumul + 4 + LargMotif), Cells(NoLigneTab2, ColFinCumul + 3 + LargMotif + LargNbH)).MergeCells = True
'Unite jour
Range(Cells(NoLigneTab2, ColFinCumul + 4 + LargMotif + LargNbH), Cells(NoLigneTab2, ColFinCumul + 3 + LargMotif + LargNbH + LargUnitJ)).MergeCells = True
'Nombre de jours
Range(Cells(NoLigneTab2, ColFinCumul + 4 + LargMotif + LargNbH + LargUnitJ), Cells(NoLigneTab2, ColFinCumul + 3 + LargMotif + LargNbH + LargUnitJ + LargNbJ)).MergeCells = True
'Montant
Range(Cells(NoLigneTab2, ColFinCumul + 4 + LargMotif + LargNbH + LargUnitJ + LargNbJ), Cells(NoLigneTab2, ColFinCumul + 3 + LargMotif + LargNbH + LargUnitJ + LargNbJ + LargMontant)).MergeCells = True
End If
'Range(Cells(NoLigneTab2, ColFinCumul + 2), Cells(NoLigneTab2, ColFinCumul + 7 + LargMotif)).MergeCells = True
NoLigneTab2 = NoLigneTab2 + 1
Wend
'Encadrer le tableau
Range(Cells(FirstLigne, ColFinCumul + 2), Cells(FirstLigne + 11, NbColTab(1) + 4)).Select
Call MiseEnFormeTab
End If |