Re : Automatiser des tâches répétitives
Bonjour, j'ai finalisé la macro. Ca tourne depuis quelques temps et ca marche sans problème. Je prends un peu de temps pour simplifier la macro en utilisant les conseils de Dranreb. Je poste une fois ces derniers détails réglés. Voici ce que la macro donne:
Private Sub CommandButton1_Click()
Dim RgT As String, N As Long, C As Long, FeuiR As Worksheet
Dim Adr As String 'Source
Dim Adr1 As String 'Destination
Dim PT As PivotTable
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT & "TCD"
'suppression des lignes avec quantités a zero
Sheets(RgT).Select
Sheets(RgT).Activate
'With Worksheets(RgT)
Dim dl As Integer 'déclare la variable dl
Dim x As Integer 'déclare la variable x
dl = Range("I65536").End(xlUp).Row 'définit la variable x (dernière ligne remplie (colonne à adapter))
For x = dl To 8 Step -1
'si la cellule de la ligne x, colonne 15 ("I") est nulle, supprime la ligne
If Sheets(RgT).Cells(x, 15).Value = 0 Then
Sheets(RgT).Rows(x).Delete
End If
Next x 'prochaine ligne de la boucle
'End With
' Tableaucroisédynamique Macro
Name = "Tcd " & C
Dest = RgT & "!A3"
Sheets(RgT).Select
'Définir où sera copié le pivottable
With Worksheets(RgT)
Adr1 = .Name & "TCD!" & .Range("A3").Address
End With
'Définir où sont les données pour le pivotcache
With Worksheets(RgT)
Adr = .Name & "!" & .Range("F7:O" & _
.Range("O65536").End(xlUp).Row).Address
'Adr = .Name & "!" & .Range("F7:O" & .Range("O65536").End(xlUp).Row).Address
'...
'..., SourceData:=Range(Adr))
'Écrivez plutôt :
'Code VBA:
'Set MaPlageSource = .Range("F7:O" & .Range("O65536").End(xlUp).Row)
'...
'..., SourceData:=MaPlageSource)
End With
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
Adr).CreatePivotTable TableDestination:= _
"'" & RgT & "TCD'!R3C1", TableName:= _
RgT, DefaultVersion:=xlPivotTableVersion10
Sheets(RgT & "TCD").Select
ActiveSheet.PivotTables(RgT).AddFields RowFields:= _
Array("Période", "Date Livraison", "RCT")
ActiveSheet.PivotTables(RgT).PivotFields("Impl."). _
Orientation = xlDataField
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveSheet.PivotTables(RgT).PivotFields("RCT"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables(RgT).PivotFields("Période"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables(RgT).PivotFields( _
"Date Livraison").Subtotals = Array(False, False, False, False, False, False, False, _
False, False, False, False, False)
ActiveSheet.PivotTables(RgT).AddFields RowFields:= _
Array("Période", "Date Livraison", "RCT")
ActiveWorkbook.ShowPivotTableFieldList = False
Next C
End Sub