Re : Aide Macro
Re-moi,
j'ai modifié le code pour changer qques petits trucs.
J'ai essayé d'ajouter un code pour faire des sous totaux, une mise en forme conditionnelle et une partie de la mise en forme pour la colonne Ecart%:
Sub Detail_Minick()
Dim NbrLignes As Long, CptLignes As Long
Dim MarchesExclus As String
MarchesExclus = ";CP;CPC;PF;PFC;PFI;"
With Sheets("DETAIL")
Application.ScreenUpdating = False
'Effacement des anciennes valeurs
.UsedRange.ClearContents
'Copie des colonnes de la source
NbrLignes = Sheets("detail source").Range("C65526").End(xlUp).Row
Sheets("detail source").Range("A12:A" & NbrLignes & ",C12:K" & NbrLignes).Copy .Range("A1")
'Masquage de la colonne E
.Columns("E").Hidden = True
'Suppression des Marches Exclus
NbrLignes = NbrLignes - 11
For CptLignes = NbrLignes To 2 Step -1
If InStr(1, MarchesExclus, ";" & UCase(.Range("B" & CptLignes).Value) & ";") <> 0 Then
.Rows(CptLignes).Delete
NbrLignes = NbrLignes - 1
End If
Next
.Columns("A").ColumnWidth = 26
.Columns("C").ColumnWidth = 14
.Columns("D").ColumnWidth = 40
'Centrage et hauteur des cellules
With .Range("A1:J" & NbrLignes)
.RowHeight = 26
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Sort key1:=.Range("A1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, key3:=.Range("C1"), order3:=xlAscending, Header:=xlYes
End With
'Alignement a gauche de la colonne D
.Range("D1
" & NbrLignes).HorizontalAlignment = xlLeft
'Mise en forme de la colonne commentaire
.Range("A1:A" & NbrLignes).Copy
With .Range("K1:R" & NbrLignes)
.PasteSpecial Paste:=xlPasteFormats
.Borders(xlInsideVertical).LineStyle = xlNone
End With
.Range("K2:R2").HorizontalAlignment = xlCenterAcrossSelection
.Range("K2").Value = "Commentaires"
Application.ScreenUpdating = True
'SOUS TOTAUX
Range("G8").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8, 10) _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7, 8, 10) _
, Replace:=False, PageBreaks:=False, SummaryBelowData:=True
'MFC
Columns("A:R").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTERREUR(CHERCHE(""Total"";$A1;1)))"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(1).Interior.ColorIndex = 35
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTERREUR(CHERCHE(""Total"";$B1;1)))"
Selection.FormatConditions(2).Interior.ColorIndex = 36
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTERREUR(CHERCHE(""CENTRE DTH"";$D1;1)))"
With Selection.FormatConditions(3).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(3).Interior.ColorIndex = 33
'Format cellules colonne Ecart%
Columns("I:I").Select
Selection.NumberFormat = "[Red]0.00%;[Blue]-0.00%"
End With
End Sub
A partir de là, je sêche. Je joins le résultat de ce que j'aimerais réussir à faire.
Ce qu'il me reste à résoudre:
_ lorsque les sous totaux sont faits, il y a trois lignes qui s'ajoutent en bas de tableaux. J'aimerais que ces lignes aient le même format que les autres lignes sauf pour la derniere ou il faudrait qu il y ait de marqué "TOTAL CENTRE DTH" en D (centré vert/hor) et que cela fasse un "cadre" de la cellule A à la cellule D (heu je sais pas si c'est tres clair lol)
_ Appliquer le format "[Rouge]0,00%;[Bleu]-0,00%" à toutes les cellules de la colonne I (Ecart%) et que ces cellules soient calculées en faisant J/H.
_ Sur la ligne 1, une formule qui reprend le nom du fichier (celle la je l'ai trouvée) et que le texte soit centré sur plusieurs cellules entre A et D.
Pareil pour le texte entre les cellules F et J avec une formule qui reprend le nom de l'onglet (j'en avais trouvé une mais comme par la suite je vais avoir d'autres onglets dans ce fichier, la formule m'affichait systématiquement le nom du dernier onglet dans lequel j'avais tapé la formule, sur tous les onglets où j'avais deja tapé cette formule)
_ Et eventuellement la mise en page comme dans le fichier joint
Merci encore par avance de l'aide que vous pourrez m'apporter. Une fois ce fichier finalisé, j'essaierai de jonglet avec les différents codes pour d'autres onglets que j'ai à faire également.
Bonne soirée
Cordialement.