Bonjour,
J'ai réalisé une petite macro de consolidation (une 20ène de fichier).
Pour me faciliter la tâche, j'ai copié toutes les feuilles sur un même fichier.
Je viens de terminer la macro de consolidation qui marche bien mais maintenant il me reste une chose à faire. Je dois rajouter une colonne (Q) dans laquelle la macro va indiquer le nom de l'onglet qui a fournit la donnée voici le code de base
Pour le code, j'étais parti sur le code ci-dessous mais il n'indique le nom de l'onglet uniquement sur la dernière ligne pour chaque onglet.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81 '' 'Déclaration des variables au niveau du Module Dim k As Integer, i As Integer Dim DerniereLigne As Integer Dim NomOnglet As String Dim LastRowConsolidation As Integer Dim LastRowConsolidation1 As Integer Dim LastRowConsolidation2 As Integer Dim LastRowConsolidation3 As Integer Dim LastRowConsolidation4 As Integer Dim LastRowConsolidation5 As Integer Dim LastRowConsolidation6 As Integer Dim LastRowConsolidation7 As Integer Dim LastRowConsolidation8 As Integer 'Procédure permettant d'effacer les données de la consolidation afin d'éviter les doublons Sub Effacedonnees() 'On se positionne sur la feuille Consolidation Worksheets("Consolidation").Select Range("C12: P155").Select Selection.Clear Range("B160: P234").Select Selection.Clear Range("B239: P420").Select Selection.Clear Range("B425: P516").Select Selection.Clear Range("B522: P598").Select Selection.Clear Range("B604: P684").Select Selection.Clear Range("B690:J738").Select Selection.Clear Range("B741:J777").Select Selection.Clear Range("B780: P830").Select Selection.Clear End Sub '*************************************************** ' Procédure permettant d'effacer les données de la consolidation afin d'éviter les doublons '*************************************************** Sub consolider() Application.ScreenUpdating = False Effacedonnees 'Boucle permettant de lire toutes les feuilles à consolider k = Sheets.Count For i = 1 To k NomOnglet = Sheets(i).Name If Sheets(i).Name <> "Consolidation" Then Sheets(i).Activate Range("C12: P31").Select Selection.Copy Sheets("Consolidation").Select LastRowConsolidation = Range("C155").End(xlUp).Row + 1 Cells(LastRowConsolidation, 3).Select ActiveSheet.Paste Range("Q" & LastRowConsolidation) = NomOnglet Application.CutCopyMode = False End If Next i Application.ScreenUpdating = True End Sub
Comment puis-je faire pour que le code le marque sur l'ensemble de la selection à chaque fois ?
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4 NomOnglet = Sheets(i).Name Range("Q" & LastRowConsolidation) = NomOnglet
Je vous remercie par avance.
Merci d'avance
Partager