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

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
M

matthieu2701

XLDnaute Occasionnel
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
job75

job75

XLDnaute Barbatruc
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

  • Incrementer_Numeros_Tableaux(1).xlsm
    24 KB · Affichages: 10
Dernière édition:
Vote positif 0 Vote négatif
M

matthieu2701

XLDnaute Occasionnel
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
job75

job75

XLDnaute Barbatruc
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

  • Tableaux(1).xlsm
    25.5 KB · Affichages: 5
Vote positif 0 Vote négatif
M

matthieu2701

XLDnaute Occasionnel
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

  • Dossiers Agorra SE Test.xlsm
    88 KB · Affichages: 7
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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
job75

job75

XLDnaute Barbatruc
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
M

matthieu2701

XLDnaute Occasionnel
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
M

matthieu2701

XLDnaute Occasionnel
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

Discussions similaires

D
  • Résolu(e)
Microsoft 365 Comment executer la deuxième partie de la macro après verification
Réponses
6
Affichages
400
mapomme
mapomme
D
  • Résolu(e)
Microsoft 365 Création d'une macro VBA - copier coller dans un nouveau tableau
Réponses
8
Affichages
442
job75
job75
H
  • Question
XL 2016 onglet récapitulatif d'un tableau
Réponses
9
Affichages
736
Cousinhub
Cousinhub
C
  • Résolu(e)
Microsoft 365 Créer un RV outlook à partir de chaque ligne d'un tableau
Réponses
8
Affichages
716
c.branco
C
N
  • Résolu(e)
XL 2016 tableau de vente/gestion des stocks boutique : quelles formules ?!
Réponses
12
Affichages
1 K
Gégé-45550
Gégé-45550
A
  • Résolu(e)
XL 2016 Graphique à partir de plusieurs tableaux
Réponses
4
Affichages
454
Alan28
A
P
  • 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
418
pdesproges
P
D
  • Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
2 K
chris
chris
Tortue33
  • 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
671
chris
chris
E
  • Question
Microsoft 365 associer la valeur d'une cellule à ma macro en sélectionnant la bonne extension année
Réponses
5
Affichages
489
Hasco
Hasco

Membres actuellement en ligne

2 membres et 54 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 047
Messages
2 084 864
Membres
102 690
dernier inscrit
souleymaane