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 45 46 47 48 49 50 51
| Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Worksheets("FTemps").Activate
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Dim Lg&, i%, x%
Application.ScreenUpdating = False
Lg = Range("a" & Rows.Count).End(xlUp).Row
Range("x2:x" & Lg) = "x"
'--- tri colonne A ---
Range("a2:b" & Lg).Sort _
Key1:=Range("a2"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'---
For i = 2 To Lg
If Cells(i + 1, "a") = Cells(i, "a") Then
x = i
Do While Cells(x + 1, "a") = Cells(i, "a")
Cells(i, "g") = Cells(i, "g") & " | " & Cells(x + 1, "g")
Cells(x + 1, "x").ClearContents
x = x + 1
Loop
i = x
End If
Next i
On Error Resume Next
For i = Lg To 2 Step -1
Cells(i, "g") = Cells(i, "g") & " | " & Cells(i, "h")
If Worksheets("FTemps").Cells(i, 24) = "" Then Worksheets("FTemps").Rows(i).Delete
Next i
Columns("x").ClearContents
TrierDate
Worksheets("Réel par projet").PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
Worksheets("Réel par projet").Activate
End Sub |
Partager