XL 2016 Macro : Numéro de tableau différent à chaque éxécution de la macro

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

matthieu2701

XLDnaute Occasionnel
Bonjour,

Je viens vers vous car je souhaite faire une macro pour automatiser des manipulation faite tous les jours.

A un moment donné, j'ouvre un tableau à partir de données d'un tableau croisé dynamique.

Une nouvelle feuille s'ouvre avec le tableau concerné. Ce tableau change de nom à chaque exécution de la macro (Tableau1 puis Tableau 2 puis Tableau 3 ...)

J'aimerais savoir comment faire pour faire évoluer le numéro du tableau en fonctionne du nombre d'exécution de la macro.

J'espère avoir été assez clair.

Merci par avance de votre aide.

Bonne journée
 
Trier par date Trier par votes
Bonjour,

Aussi, mon fichier d'export modifie tous les jours la date du jour.

Son format est "Export_Dossiers_Agorra_20190604.csv

J'ai renseigné la date du jour dans la cellule C1 avec le bon format de date et dans VBA j'ai noté
("Export_Dossiers_Agorra_" & Sheets("Dossiers à Valoriser").Range("C1") & ".csv")
mais cela ne fonctionne pas.

Merci par avance de votre aide.
 
Vote positif 0 Vote négatif
Bonsoir matthieu2701,

Pour le 1er problème voyez le fichier joint et cette macro :
VB: 
Sub Incrementer_Numeros_Tableaux()
Dim racine$, LO As ListObject
racine = "Tableau" 'à adapter
For Each LO In ActiveSheet.ListObjects
    If LO.Name Like racine & "#*" Then LO.Name = "µµµ" & Val(Mid(LO.Name, Len(racine) + 1)) + 1 'nom provisoire
Next
For Each LO In ActiveSheet.ListObjects
    If LO.Name Like "µµµ#*" Then LO.Name = Replace(LO.Name, "µµµ", racine) 'nom définitif
Next
End Sub
Pour le 2ème problème la date en C1 crée des "/" dans le nom du fichier, ce sont des caractères interdits.

Il suffit de formater la date correctement :
VB: 
x = "Export_Dossiers_Agorra_" & Format(Sheets("Dossiers à Valoriser").Range("C1"), "yyyymmdd") & ".csv"
A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonjour,

Merci de ton retour.

Parfait pour la solution au 2eme problème.

Néanmoins, pour le 1er je ne comprend pas comment l'intégrer à ma macro.

Le tableau dont je parle se crée lorsque je clique sur un élément de mon tabelau croisé dynamique et se nomme "Tableau1" et laa fois d'après "Tableau2" ...

J'aimerais que le numéro du tableau évolue dans la macro afin qu'il soit identique à Excel. Aussi, lors de cette macro, plusieurs tableaux sont créés et je souhaite le même procédé.

Merci

Voici la macro

VB: 
Sub Export()
'
' Export Macro

'
    Sheets("Export Agorra quotidien ").Select
    Windows("Export_Dossiers_Agorra_" & Format(Sheets("Dossiers à Valoriser").Range("C1"), "yyyymmdd") & ".csv").Activate
    Range("A2").Select
    Windows("Dossiers Agorra SE Test.xlsm").Activate
    Windows("Export_Dossiers_Agorra_" & Format(Sheets("Dossiers à Valoriser").Range("C1"), "yyyymmdd") & ".csv").Activate
    Selection.End(xlDown).Select
    Windows("Dossiers Agorra SE Test.xlsm").Activate
    Windows("Export_Dossiers_Agorra_" & Format(Sheets("Dossiers à Valoriser").Range("C1"), "yyyymmdd") & ".csv").Activate
    Range("A2:N163").Select
    Range("A163").Activate
    Selection.Copy
    Windows("Dossiers Agorra SE Test.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Point à date").Select
    Application.CutCopyMode = False
    ActiveWorkbook.RefreshAll
    Range("B6").Select
    Selection.ShowDetail = True
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("C2").Select
    ActiveCell.Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("Tableau9[[#Headers],[Code Centre]]").Select 'Ici le tableau se nomme "Tableau9"
    Range("Tableau9").Select
    Range("A70").Activate
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    Sheets("Dossiers à Valoriser").Select
    Range("B8").Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("A1").Select
    Range("B8:I76").Select
    Range("B76").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=132
    Rows("8:223").Select
    Range("A223").Activate
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveWindow.ScrollRow = 1
    Sheets("Feuil8").Select
    Selection.Copy
    Sheets("Dossiers à Valoriser").Select
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil8").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Sheets("Point à date").Select
    Range("B7").Select
    Selection.ShowDetail = True
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:J").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    Sheets("Dossiers à Valoriser").Select
    Range("D8").Select
    ActiveCell.Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, -2).Range("A1").Select
    Sheets("Feuil9").Select
    Range("C2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("Tableau9[[#Headers],[Code Centre]]").Select
    Range("Tableau9").Select
    Range("A9").Activate
    Selection.Copy
    Sheets("Dossiers à Valoriser").Select
    Range("B77").Select
    Sheets("Feuil9").Select
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("C2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("Tableau9[[#Headers],[Code Centre]]").Select
    Range("Tableau9").Select
    Range("A9").Activate
    Selection.Copy
    Sheets("Dossiers à Valoriser").Select
    ActiveWindow.SmallScroll Down:=-69
    Range("D8").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, -2).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-45
    Columns("F:F").Select
    Application.CutCopyMode = False
    Range("F7").Select
    ActiveWorkbook.Worksheets("Dossiers à Valoriser").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dossiers à Valoriser").Sort.SortFields.Add Key:= _
        Range("F7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Dossiers à Valoriser").Sort
        .SetRange Range("B8:I553")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Feuil9").Select
    ActiveWindow.SelectedSheets.Delete
    Range("C17").Select
    Selection.ShowDetail = True
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Dossiers à Facturer ").Select
    ActiveWindow.SmallScroll Down:=-84
    Range("D8").Select
    ActiveCell.Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("A1").Select
    Range("B8:I29").Select
    Range("B29").Activate
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Feuil10").Select
    Range("C2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("Tableau10[[#Headers],[Code Centre]]").Select
    Range("Tableau10").Select
    Range("A15").Activate
    Sheets("Feuil10").Select
    Selection.Copy
    Sheets("Dossiers à Facturer ").Select
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil10").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Range("C18").Select
    Selection.ShowDetail = True
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Dossiers à Facturer ").Select
    Range("D8").Select
    ActiveCell.Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, -2).Range("A1").Select
    Sheets("Feuil11").Select
    Range("C2").Select
    ActiveCell.Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("Tableau11[[#Headers],[Code Centre]]").Select
    Range("Tableau11").Select
    Range("A21").Activate
    Selection.Copy
    Sheets("Dossiers à Facturer ").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil11").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Range("C22").Select
    Selection.ShowDetail = True
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Dossiers à Facturer ").Select
    Range("D8").Select
    Selection.End(xlDown).Select
    Range("D8").Select
    ActiveCell.Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, -2).Range("A1").Select
    Sheets("Feuil12").Select
    Range("Tableau12[N° Dossier]").Select
    Selection.End(xlDown).Select
    ActiveWindow.ScrollRow = 1048535
    ActiveWindow.ScrollRow = 1045887
    ActiveWindow.ScrollRow = 1040591
    ActiveWindow.ScrollRow = 1036619
    ActiveWindow.ScrollRow = 745360
    ActiveWindow.ScrollRow = 631504
    ActiveWindow.ScrollRow = 452777
    ActiveWindow.ScrollRow = 419679
    ActiveWindow.ScrollRow = 229036
    ActiveWindow.ScrollRow = 211826
    ActiveWindow.ScrollRow = 182700
    ActiveWindow.ScrollRow = 180052
    ActiveWindow.ScrollRow = 140335
    ActiveWindow.ScrollRow = 54281
    ActiveWindow.ScrollRow = 46337
    ActiveWindow.ScrollRow = 39718
    ActiveWindow.ScrollRow = 37070
    ActiveWindow.ScrollRow = 34422
    ActiveWindow.ScrollRow = 18535
    ActiveWindow.ScrollRow = 14563
    ActiveWindow.ScrollRow = 10592
    ActiveWindow.ScrollRow = 1
    ActiveCell.Offset(-1048575, 0).Range("Tableau12[[#Headers],[Code Centre]]"). _
        Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("Tableau12[[#Headers],[Code Centre]]").Select
    Range("Tableau12").Select
    Selection.Copy
    Sheets("Dossiers à Facturer ").Select
    ActiveSheet.Paste
    Sheets("Feuil12").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Range("C23").Select
    Selection.ShowDetail = True
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Dossiers à Facturer ").Select
    Range("D8").Select
    ActiveCell.Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, -2).Range("A1").Select
    Sheets("Feuil13").Select
    Range("Tableau13[[#Headers],[N° Dossier]]").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("Tableau13[[#Headers],[Code Centre]]").Select
    Range("Tableau13").Select
    Selection.Copy
    Sheets("Dossiers à Facturer ").Select
    ActiveSheet.Paste
    Range("D8").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Range("A1").Select
    Range("B8:I43").Select
    Range("B43").Activate
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("H8").Select
    Selection.End(xlDown).Select
    ActiveWindow.ScrollRow = 1048535
    ActiveWindow.ScrollRow = 1045887
    ActiveWindow.ScrollRow = 1032648
    ActiveWindow.ScrollRow = 1015437
    ActiveWindow.ScrollRow = 996902
    ActiveWindow.ScrollRow = 377314
    ActiveWindow.ScrollRow = 278021
    ActiveWindow.ScrollRow = 178728
    ActiveWindow.ScrollRow = 170784
    ActiveWindow.ScrollRow = 75463
    ActiveWindow.ScrollRow = 52957
    ActiveWindow.ScrollRow = 31774
    ActiveWindow.ScrollRow = 21183
    ActiveWindow.ScrollRow = 1
    ActiveCell.Offset(-1048568, -4).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 4).Range("A1").Select
    Range("H8:I43").Select
    Range("H43").Activate
    Selection.ClearContents
    Range("F7").Select
    ActiveWorkbook.Worksheets("Dossiers à Facturer ").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dossiers à Facturer ").Sort.SortFields.Add Key:= _
        Range("F7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Dossiers à Facturer ").Sort
        .SetRange Range("B8:I43")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Point à date").Select
End Sub
 
Vote positif 0 Vote négatif
Pour que l'on comprenne ce qu'il faut faire il faudrait joindre le fichier avec des explications claires.

En attendant voyez le fichier joint et cette macro :
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(ActiveCell, Me.PivotTables(1).TableRange1) Is Nothing Then Exit Sub
Dim racine$, LO As ListObject
racine = "Tableau" 'à adapter
For Each LO In ActiveSheet.ListObjects
    If LO.Name Like racine & "#*" Then LO.Name = "µµµ" & Val(Mid(LO.Name, Len(racine) + 1)) + 1 'nom provisoire
Next
For Each LO In ActiveSheet.ListObjects
    If LO.Name Like "µµµ#*" Then LO.Name = Replace(LO.Name, "µµµ", racine) 'nom définitif
Next
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour,

Je mets en PJ le fichier concerné.

Dans la feuille "Export Agorra quotidien" je colle les données d'un export que je fais tous les jours.

Ensuite, j'actualise les données dans la feuille "Point à date". Toujours dans cette feuille, je double clique sur, par exemple, la cellule B68 qui me génère une nouvelle feuille avec toutes les données des dossiers étant au statut "Dossier à prendre en charge".

Je renouvelle l'opération pour les autres catégories.

C'est ici que se pose mon problème. A chaque fois qu'une feuille se crée son numéro est différent et le tableau obtenu change aussi de numéro
1032639


Je souhaiterais que la macro fasse évoluer le numéro de la feuille et du tableau afin que cela colle à ce qu'Excel affiche.

J'espère que c'est plus clair.

Merci par avance.
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour mathieu2701,

Vous parlez de cellule B68, je pense qu'il s'agit de B6 ou B19...

Ceci n'est pas clair du tout :
matthieu2701 à dit:
Je souhaiterais que la macro fasse évoluer le numéro de la feuille et du tableau afin que cela colle à ce qu'Excel affiche.
Cliquez pour agrandir...
Il est normal que les tableaux créés portent de nouveaux numéros, de même que les feuilles, quel est le problème ? Que voulez vous faire ?

A+
 
Vote positif 0 Vote négatif
Si vous voulez récupérer les noms de la feuille et du tableau créés placez une macro de ce genre dans ThisWorkbook :
VB: 
Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sh.ListObjects.Count = 0 Then Exit Sub
Dim NomFeuille$, NomTableau$
NomFeuille = Sh.Name
NomTableau = Sh.ListObjects(1).Name
MsgBox NomFeuille & vbLf & NomTableau 'pour tester
End Sub
Vous faites ensuite ce que vous voulez avec les noms récupérés.
 
Vote positif 0 Vote négatif
job75 à dit:
Si vous voulez récupérer les noms de la feuille et du tableau créés placez une macro de ce genre dans ThisWorkbook :
VB: 
Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sh.ListObjects.Count = 0 Then Exit Sub
Dim NomFeuille$, NomTableau$
NomFeuille = Sh.Name
NomTableau = Sh.ListObjects(1).Name
MsgBox NomFeuille & vbLf & NomTableau 'pour tester
End Sub
Vous faites ensuite ce que vous voulez avec les noms récupérés.
Cliquez pour agrandir...

Effectivement, je veux récupérer le nom des feuilles et tableau créés.

Je vais tester votre macro.

Merci
 
Vote positif 0 Vote négatif
job75 à dit:
Si vous voulez récupérer les noms de la feuille et du tableau créés placez une macro de ce genre dans ThisWorkbook :
VB: 
Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sh.ListObjects.Count = 0 Then Exit Sub
Dim NomFeuille$, NomTableau$
NomFeuille = Sh.Name
NomTableau = Sh.ListObjects(1).Name
MsgBox NomFeuille & vbLf & NomTableau 'pour tester
End Sub
Vous faites ensuite ce que vous voulez avec les noms récupérés.
Cliquez pour agrandir...

J'ai testé et j'obtiens bien la msgbox.

Néanmoins, je n'arrive pas à intégrer ces noms dans ma macro.

J'ai remplacé les données "Feuillx" par "NomFeuille" et "Tableaux" par "NomTableau" mais cela ne fonctionne pas.

Comment faire pour récupérer ces noms dans mon module 1 ?

Merci
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

P
  • Question Question
Microsoft 365 Insertion texte + numéro qui change à chaque changement de ligne
Réponses
4
Affichages
132
ptit_ange69
P
R
  • Question Question
XL 2019 Aide à la création d'un fichier de saisie et suivi des engagements budgétaires sous Excel
Réponses
2
Affichages
228
Royaulté
R
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
481
JJ69
J
D
  • Résolu(e)
Microsoft 365 Comment executer la deuxième partie de la macro après verification
Réponses
6
Affichages
796
mapomme
mapomme
D
  • Résolu(e)
Microsoft 365 Création d'une macro VBA - copier coller dans un nouveau tableau
Réponses
8
Affichages
878
job75
job75
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
4 K
crocrocro
C
C
  • Résolu(e)
Microsoft 365 Créer un RV outlook à partir de chaque ligne d'un tableau
Réponses
8
Affichages
1 K
c.branco
C
H
  • Question Question
XL 2016 onglet récapitulatif d'un tableau
Réponses
9
Affichages
1 K
Cousinhub
Cousinhub
D
  • Question Question
Microsoft 365 Cas réel - avec problème complexe sur de la prevision de match en evitant les doublons
Réponses
1
Affichages
844
Dock91
D
N
  • Résolu(e)
XL 2016 tableau de vente/gestion des stocks boutique : quelles formules ?!
2
Réponses
17
Affichages
3 K
Noëllie
N
O
  • Question Question
XL 2019 Code VBA pour automatiser la programmation des rotations des ouvriers qui travaillent à temps partiel et se relaient par période de temps constante.
2 3
Réponses
35
Affichages
2 K
olivier1984
O
A
  • Résolu(e)
XL 2016 Graphique à partir de plusieurs tableaux
Réponses
4
Affichages
741
Alan28
A
P
  • Question Question
Microsoft 365 utilisation de la fonction EQUIV avec la fonction INDIRECT pour rechercher un numéro de ligne dans différents onglets
Réponses
2
Affichages
628
pdesproges
P
D
  • Question Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
3 K
chris
chris
Tortue33
  • Question Question
Power Query Mettre une check box à la fin de chaque ligne de mon tableau généré par Power Query
Réponses
6
Affichages
1 K
chris
chris
E
  • Question Question
Microsoft 365 associer la valeur d'une cellule à ma macro en sélectionnant la bonne extension année
Réponses
5
Affichages
749
Hasco
Hasco
E
  • Résolu(e)
Microsoft 365 Conception d'un outils alliant faciliter d'utilisation et optimisation de la RAM/Processeur/Espace Disque
Réponses
6
Affichages
805
elgringo123456
E
F
  • Question Question
Microsoft 365 Listes "popup" de choix multiples associées à des cellules ...
Réponses
4
Affichages
1 K
riton00
riton00
J
  • Question Question
Microsoft 365 Construction d'un tableau de bord agence architecture
Réponses
13
Affichages
2 K
vinzwanted
V
Lu76Fer
XLS : Evènements souris 'click' sur la grille & astuces
Réponses
3
Affichages
312
Lu76Fer
Lu76Fer
Retour