Bonsoir à tous,
J'ai le même code VBA qui se répéte sur plusieurs feuilles de calcul. Y-a-t-il un moyen de le simplifier plutôt que de le répéter à chaque fois ? Je vous remercie d'avance pour votre aide.
Merci.
Ci-joint le code en question (dans cet exemple, le code n'est répété que 2 fois) :
Sub Rubriques_A()
' Extraction Rubrique A01
Sheets("A01").Select
'Efface le tableau à partir de la cellule AA13
Range("AA13").CurrentRegion.Clear
'Sélectionnela BDD, applique le filtre élaboré puis colle le résultat en cellule AC12
Range("BDD!Lancer_la_requête_à_partir_de_MS_Access_Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("A12").CurrentRegion, _
CopyToRange:=Range("AC12"), _
Unique:=False
'Crée 2 en-tête de colonne en AA12 et AB12
Range("AA12").Value = "Code Rubrique"
Range("AB12").Value = "Intitulé Rubrique"
Range("AA12:AB12").Font.Bold = True
'Rempli les colonnes AA et AB d'après les données en B2 et B3
x = Range("AC65536").End(xlUp).Row
Range("AA13", "AA" & x).Value = Range("B2")
Range("AB13", "AB" & x).Value = Range("B3")
Range("AA13", "AB" & x).Font.Size = 8
'Ajustement automatique des largeurs de colonnes
Range("AA13").CurrentRegion.EntireColumn.AutoFit
' Extraction Rubrique A02
Sheets("A02").Select
'Efface le tableau à partir de la cellule AA13
Range("AA13").CurrentRegion.Clear
'Sélectionnela BDD, applique le filtre élaboré puis colle le résultat en cellule AC12
Range("BDD!Lancer_la_requête_à_partir_de_MS_Access_Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("A12").CurrentRegion, _
CopyToRange:=Range("AC12"), _
Unique:=False
'Crée 2 en-tête de colonne en AA12 et AB12
Range("AA12").Value = "Code Rubrique"
Range("AB12").Value = "Intitulé Rubrique"
Range("AA12:AB12").Font.Bold = True
'Rempli les colonnes AA et AB d'après les données en B2 et B3
x = Range("AC65536").End(xlUp).Row
Range("AA13", "AA" & x).Value = Range("B2")
Range("AB13", "AB" & x).Value = Range("B3")
Range("AA13", "AB" & x).Font.Size = 8
'Ajustement automatique des largeurs de colonnes
Range("AA13").CurrentRegion.EntireColumn.AutoFit
End Sub
J'ai le même code VBA qui se répéte sur plusieurs feuilles de calcul. Y-a-t-il un moyen de le simplifier plutôt que de le répéter à chaque fois ? Je vous remercie d'avance pour votre aide.
Merci.
Ci-joint le code en question (dans cet exemple, le code n'est répété que 2 fois) :
Sub Rubriques_A()
' Extraction Rubrique A01
Sheets("A01").Select
'Efface le tableau à partir de la cellule AA13
Range("AA13").CurrentRegion.Clear
'Sélectionnela BDD, applique le filtre élaboré puis colle le résultat en cellule AC12
Range("BDD!Lancer_la_requête_à_partir_de_MS_Access_Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("A12").CurrentRegion, _
CopyToRange:=Range("AC12"), _
Unique:=False
'Crée 2 en-tête de colonne en AA12 et AB12
Range("AA12").Value = "Code Rubrique"
Range("AB12").Value = "Intitulé Rubrique"
Range("AA12:AB12").Font.Bold = True
'Rempli les colonnes AA et AB d'après les données en B2 et B3
x = Range("AC65536").End(xlUp).Row
Range("AA13", "AA" & x).Value = Range("B2")
Range("AB13", "AB" & x).Value = Range("B3")
Range("AA13", "AB" & x).Font.Size = 8
'Ajustement automatique des largeurs de colonnes
Range("AA13").CurrentRegion.EntireColumn.AutoFit
' Extraction Rubrique A02
Sheets("A02").Select
'Efface le tableau à partir de la cellule AA13
Range("AA13").CurrentRegion.Clear
'Sélectionnela BDD, applique le filtre élaboré puis colle le résultat en cellule AC12
Range("BDD!Lancer_la_requête_à_partir_de_MS_Access_Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("A12").CurrentRegion, _
CopyToRange:=Range("AC12"), _
Unique:=False
'Crée 2 en-tête de colonne en AA12 et AB12
Range("AA12").Value = "Code Rubrique"
Range("AB12").Value = "Intitulé Rubrique"
Range("AA12:AB12").Font.Bold = True
'Rempli les colonnes AA et AB d'après les données en B2 et B3
x = Range("AC65536").End(xlUp).Row
Range("AA13", "AA" & x).Value = Range("B2")
Range("AB13", "AB" & x).Value = Range("B3")
Range("AA13", "AB" & x).Font.Size = 8
'Ajustement automatique des largeurs de colonnes
Range("AA13").CurrentRegion.EntireColumn.AutoFit
End Sub