Automatiser des tâches répétitives

[Le_Goret]

Bonjour,

Je suis stagiaire dans une entreprise et on me demande de remplacer au pied levé une personne malade. Tous les matins cette personne ouvre un fichier Excel (toujours au même format) et y effectue les mêmes tâches. Ci-joint la maquette du fichier en question.

Chaque matin:

1) Vérifier que le tableau ne fasse pas plus de 1000 lignes. Aviser si plus de 1000 lignes.

2) Contrôle de la colonne H dans le premier onglet du fichier. Il ne doit y avoir que 5 types de valeurs (P1, P2, P3,P4,P5). Aviser si autres références.

3)Vérifier les dates des colonne J, M et N. Remplacer les cellules contenant la valeur "00/01/1900" par celle de la cellule correspondante de la colonne I (Date Mini).
Si cellule de la colonne M est non vide alors mettre "TA" dans la cellule correspondante de la colonne H "Période" de cette feuille de calcul.

4) Créer un nouvel onglet pour chaque point de vente (à partir de la colonne O). Il peut y avoir plusieurs dizaines de sites. Chaque nouvel onglet reprend les colonnes de A à N. On ajoute la colonne présente dans l'onglet reprenant les informations du site.

Quelqu'un pourrait-il me donner la trame d'une macro qui me permettrait d'automatiser ces tâches? Je me forme tout seul sur VBA ce serait gentil de commenter la macro histoire que je puisse comprendre comment elle marche. N'hésitez pas à me demander si il vous manque des infos ou tout simplement si je n'ai pas été assez clair!!! Merci.

Le_Goret

 

[Le_Goret]

Re : Automatiser des tâches répétitives

Merci pour ta réponse Dranreb. Je n'ai pas utilisé RgT car je n'arrivais pas à faire marcher la macro avec range. Je fais des recherches sur les objets range. Je bricole pour arriver à le faire marcher. Je vous tiens au courant.

 

[Le_Goret]

Re : Automatiser des tâches répétitives

Je pense avoir avancé. J'ai fait des recherches, je ne comprends pas tout ce que je lis. Je bricole à droite à gauche? Là la macro semble presque terminé. Ca 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"

' 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

'Création du PivotTable
(SourceType:=xlDatabase, SourceData:=Range(Adr)) _
.CreatePivotTable(TableDestination:=Range(Adr1), _
TableName:="Denis", DefaultVersion:=xlPivotTableVersion10)[/U]End WithWith PT
.PivotFields("RCT"). _[/COLOR] Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
.PivotFields("Période"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
.PivotFields("Date Livraison").Subtotals = Array(False, False, False, False, False, False, False, _
False, False, False, False, False)
.AddFields RowFields:= _
Array("Période", "Date Livraison", "RCT")
.PivotFields("Impl.").Orientation = xlDataField
Range("B5").Select
End With


Next C
End Sub

Avec le débogueur j'arrive jusqu'à l'endroit surligné en bleu. Le reste à l'air de marcher. J'ai une erreur définie par l'application ou par l'objet. Je sais que le problème vient du range qu'il faute traduire en Rge mais je n'arrive pas à avoir la bonne écriture reconnue par excel. Est ce que quelqu'un peut juste me donner un exemple? Je me débrouillerai en procédant par analogie. Merci à vous!!!
Le_Goret.

 

[Le_Goret]

Re : Automatiser des tâches répétitives

Ca y est j'ai trouvé! Voilà ce que ca 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


' 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
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

J'ai trouvé des lignes de code avec RgT et j'ai reproduit la même chose... Je voudrais maintenant améliorer la macro. Je voudrais que dans mes onglets les lignes où mes implantations sont nulles soient supprimées. J'ai inséré 'suppression des lignes avec quantités a zero dans ma macro. Pensez-vous que ce soit le bon endroit pour implanter le code? Pouvez-vous me donner le language VBA pour supprimer une ligne? Merci à vous.

Le_Goret.

 

[Dranreb]

Re : Automatiser des tâches répétitives

Bonjour.
Ne manque-t-il pas quelque chose au début de cette partie en bleu, une référence de méthode appelée par exemple ?
Au lieu de construire des String à l'aide de méthode Address de Range en vue de les utiliser comme référence pour définir des Range, construisez donc directement... des Range bon sang !

Vous avez par exemple écrit :

Adr = .Name & "!" & .Range("F7:O" & .Range("O65536").End(xlUp).Row).Address
...
..., SourceData:=Range(Adr))

Ridicule ! Écrivez plutôt :

Set MaPlageSource = .Range("F7:O" & .Range("O65536").End(xlUp).Row)
...
..., SourceData:=MaPlageSource)

sans compter que ce sera plus facile au débogage de vérifier ce que contient votre variable Range !
À+

 

[Le_Goret]

Re : Automatiser des tâches répétitives

Merci des conseils Dranreb!!! C'est très bien expliqué. C'est vrai que c'est plus facile rien qu'à la relecture. Je débute sur VBA aussi je reprends les corps de macro déjà existantes et je les imbrique les unes aux autres. A moi de savoir simplifier ma macro plus tard... Sauriez-vous quelle écriture utiliser pour supprimer une ligne sur VBA? Je simplifie ma macro celon vos conseils et je la fais partager une fois finalisée.

Le_Goret.

 

[Dranreb]

Re : Automatiser des tâches répétitives

L'enregistreur de macro vous aurait engendré un :

    Selection.EntireRow.Delete

 

[Le_Goret]

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