aide pour creation d'une macro

D

delinson

XLDnaute Nouveau
Bonjour

dans le cadre de mon travail je dois établir des refacturations. pour cela je dois établir une fiche de détail et j aimerai automatiser la création de celle ci.

J ai crée une macro par rapport au résultat de mon tableau croisé dynamique mais j aimerai en faite qu'elle se crée toute à partir de ce tableau.

en résumé je dois cliqué sur toute les cellules de mon tcd puis lancé ma macro après l'obtention de mon résultat. Hors j'aimerai que cette partie soit aussi automatiser. Donc si 100 ligne dans mon tcd je dois répéter l'action 100 fois...

exemple de mon tcd pour vous donner un avis dans la colonne total j ai le détail de ce qui doit être refacturé à chaque entité il peut y en avoir une centaine:

DM Total
pierre 904,64
paul 55,58
jacque 1000,98
pedro 3641,02
fabien 924,39


voici le détail de ma macro pour transformer le détail de mon resultat tcd en feuille de détail pour la refacturation:

Sub detailfacture()
'
' detailfacture Macro
' Macro enregistrée le 31/05/2012 par ucta012
'
' Touche de raccourci du clavier: Ctrl+l
Cells.Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("F1").Select
ActiveCell.FormulaR1C1 = "Détail facture "
Range("G1").Select
ActiveCell.FormulaR1C1 = "=+R[4]C[-2]"
Range("H1").Select
ActiveCell.FormulaR1C1 = " "
Range("I1").Select
ActiveCell.FormulaR1C1 = "=+R[4]C[-8]"
Range("K1").Select
ActiveCell.FormulaR1C1 = "=+CONCATENATE(RC[-5],RC[-4],RC[-3],RC[-2])"
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1:K1").Select
Application.CutCopyMode = False
Selection.ClearContents
Columns("A:E").Select
Range("E1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.Underline = xlUnderlineStyleSingle
Range("F1").Select
ActiveCell.FormulaR1C1 = "Total:"
Range("F1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("F4").Select
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
End Sub


Donc j'aimerai juste rajouter en ligne de code a ma macro qu'elle sélectionne la première cellule de mon tcd puis qu'elle effectue la macro détailler ci-dessus puis qu'elle passe a la ligne suivante jusqu’à ce qu'il n y ai plus de facture a détailler.

j’espère que cela est possible

cordiallement

je travaille sur excel 2003 pour l'instant
 
Trier par date Trier par votes
V

VDAVID

XLDnaute Impliqué
Re : aide pour creation d'une macro

Bonjour Delinson,

Pour répéter une action x fois sur une plage de données à ligne variable, tu peux créer un boucle Long sur les numéros de lignes.

Tu peux essayer, avec en "A" la première colonne de ton TDC, A1 la où il commence:

Code: 
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row Step 1 '1 = Numéro de ligne de la première case de ton TDC, Range("A65536").End(xlUp).Row la dernière (recherche automatiquement la dernière case non vide de la colonne "A")
'Ton code
Next i
End Sub

Bonne journée
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : aide pour creation d'une macro

Bonjour le fil, bonjour le forum,

@Vdavid : pourquoi Step 1 ? Est-ce à cause du TCD que je ne connais absolument pas ? Le TCD n'est-il pas comme une sorte de filtre qui n'affiche que certaines lignes ? Ne faudrait-il pas utiliser Range(leTableau).SpecialCells(xlCellTypeVisible) pour ne boucler que sur les lignes visibles du tableau ? J'étais en train de me poser toutes ces questions quand j'ai vu ta réponse. Du coup c'est à toi que je les pose...
 
Vote positif 0 Vote négatif
V

VDAVID

XLDnaute Impliqué
Re : aide pour creation d'une macro

Bonjour Robert,

@Vdavid : pourquoi Step 1 ?
Cliquez pour agrandir...

Je l'ai mis simplement par "réflexe", comme je travaille sur un document dans lequel je supprime des lignes via la même méthode (boucle i), où je suis obligé de renseigner le step - 1, mais içi c'est vrai qu'il est superflu :eek:

Le TCD n'est-il pas comme une sorte de filtre qui n'affiche que certaines lignes ?
Cliquez pour agrandir...

Effectivement c'est une erreur de ma part, je n'utilise jamais de TDC dans mes fichiers, et je suis parti du principe qu'il se redimensionnait, et non qu'il masquait les lignes !
Mea-culpa, je modifie ma proposition :

Code: 
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row Step 1 '1 = Numéro de ligne de la première case de ton TDC, Range("A65536").End(xlUp).Row la dernière (recherche automatiquement la dernière case non vide de la colonne "A")

If Rows(i).Hidden = False Then
'Ton code
End if
Next i
End Sub

Qui boucle uniquement sur les lignes visibles

Encore une fois autant pour moi, mais comme je l'ai dit:
Tu peux essayer
Cliquez pour agrandir...

Donc je ne prétends pas donner de solutions parfaites, juste essayer d'aider :cool:

J'espère avoir répondu à tes questions qui m'ont permis par ailleurs de rectifier mon code (Du moins je l'espère :) )
 
Vote positif 0 Vote négatif
D

delinson

XLDnaute Nouveau
Re : aide pour creation d'une macro

bon j ai essayé. C'est presque bon je pense qu'il y a une toute petite erreur.
le resultat donné et bon pour la premiere feuille mais apres les suivantes sont vide.

il me donne le bon nombre de feuille mais elles sont vide...

voila l'algorythme
Sub detailfacture()
'
' detailfacture Macro
' Macro enregistrée le 31/05/2012 par ucta012
'
' Touche de raccourci du clavier: Ctrl+l
Dim i&
For i = 1 To Range("b300").End(xlUp).Row Step 1 '1 = 5
If Rows(i).Hidden = False Then
Cells.Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("F1").Select
ActiveCell.FormulaR1C1 = "Détail facture "
Range("G1").Select
ActiveCell.FormulaR1C1 = "=+R[4]C[-2]"
Range("H1").Select
ActiveCell.FormulaR1C1 = " "
Range("I1").Select
ActiveCell.FormulaR1C1 = "=+R[4]C[-8]"
Range("K1").Select
ActiveCell.FormulaR1C1 = "=+CONCATENATE(RC[-5],RC[-4],RC[-3],RC[-2])"
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1:K1").Select
Application.CutCopyMode = False
Selection.ClearContents
Columns("A:E").Select
Range("E1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.Underline = xlUnderlineStyleSingle
Range("F1").Select
ActiveCell.FormulaR1C1 = "Total:"
Range("F1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("F4").Select
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
End If
Next i
End Sub
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : aide pour creation d'une macro

Bonsoir le fil, bonsoir le forum,

Sans fichier pas facile de trouver le problème... Cependant quelques remarques :
• quand tu ajoutes un classeur, c'est ce dernier qui devient actif et comme dans le code tu ne fais pas référence au classeur source, c'est le classeur ajouté qui détermine les Range après la première boucle.
• évite les Select inutiles qui ralentissent considérablement l'exécution du code. On peut obtenir les même résultat sans sélectionner.
• une boucle sur un nombre de lignes i dans laquelle tu rajoutes des lignes... Pas sûr que ça fonctionne correctement
Le code modifié :
Code: 
Sub detailfacture()
'
' detailfacture Macro
' Macro enregistrée le 31/05/2012 par ucta012
'
' Touche de raccourci du clavier: Ctrl+l
Dim i&With ThisWorkbook.Sheets("Feuil1") 'nom de l'onglet à adapter
    For i = 1 To .Range("b300").End(xlUp).Row
        If R.ows(i).Hidden = False Then
            .Rows("1:1").Insert Shift:=xlDown
            .Rows("1:1").Insert Shift:=xlDown
            .Rows("1:1").Insert Shift:=xlDown
            .Range("F1").Value = "Détail facture "
            .Range("G1").FormulaR1C1 = "=+R[4]C[-2]"
            .Range("H1").Value = " "
            .Range("I1").FormulaR1C1 = "=+R[4]C[-8]"
            .Range("K1").FormulaR1C1 = "=+CONCATENATE(RC[-5],RC[-4],RC[-3],RC[-2])"
            .Range("K1").Copy
            .Range("F1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=False
            .Range("G1:K1").ClearContents
            .Columns("A:E").Delete Shift:=xlToLeft
            With .Range("A1")
                .Font.Bold = True
                .Font.Italic = True
                .Font.Underline = xlUnderlineStyleSingle
            End With
            .Range("F1").Value = "Total:"
            .Range("F4").Copy
            With .Range("F1")
                .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            .Cells.Copy
            Workbooks.Add
            ActiveSheet.Paste
        End If
    Next i
End With
End Sub
 
Vote positif 0 Vote négatif
D

delinson

XLDnaute Nouveau
Re : aide pour creation d'une macro

Bonjour merci de vos réponse mais je n y arrive toujours pas...

je vais vous mettre une copie de mon fichier ou j ai changer les information qui ne doivent pas etre divulgué. La macro s effectue en faisant controle l apres avoir double cliquer sur une cellule de mon tcd.



J'aimerai ne plus avoir a cliquer sur mon tcd et pouvoir faire tous les detail de facture pour ttes les cellule de mon tableau en une seul fois

cordialement
 

Pièces jointes

  • essais excel download.xls
    155 KB · Affichages: 35
Vote positif 0 Vote négatif
D

delinson

XLDnaute Nouveau
Re : aide pour creation d'une macro

Bonjour,

en fait ce que je cherche a faire si c'est possible c est reussir a créer une boucle de ma macro pour tous les élément de mon tcd (onglet feuil1).

A l'heure actuel je si je veux faire le detail facture de ma ligne "dma" je dois cliquer sur le total de cette ligne et ensuite lancer ma macro "ctrl +l".

J'aimerai automatiser ma tache de maniere à ce que je n'ai plus a cliquer ds le tcd et que tous mes détail se fasse automatiquement.

Je ne sais pas si c est possible d'automatiser le faite de cliquer dans le tableau dynamique...

cordialement

et un grand merci au courageux qui se penche sur mon probleme
 
Vote positif 0 Vote négatif
D

delinson

XLDnaute Nouveau
Re : aide pour creation d'une macro

en faite il me manque le debut de la macro c est a dire cliquer ds le tableau croisé dynamique pour obtenir les information concernant mon detail. J'ai reussi a crée la macro pour la mise en forme. A lheure actuel rien est automatisé a partir de mon tableau croisé dynamique. Je dois manuellement cliqué dans chaque case pour obtenir le detail.
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
271
robpellan52
R
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
339
gwenn49
G
G
  • Résolu(e)
Copie de données d'une feuille à une autre
Réponses
2
Affichages
215
gui22
G
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
373
fanou06
F
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
563
Kevin38
K
Y
  • Question
Microsoft 365 Insérer des lignes selon variable
Réponses
1
Affichages
232
gbinforme
G
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
109
marie3107
M
S
  • Résolu(e)
XL 2019 VBA pour créer un nouvel onglet
Réponses
2
Affichages
465
sum01
S
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
529
mouchtre
mouchtre

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 22 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote