Racourcir une macro

Le 25/02/2023 à 21:57

bonjour

j'ai une macro qui fonctionne avec 6 feuilles différentes dans le but de rechercher un nom

Je sais qu'il est possible à l'aide d'une variable de racourcir cette macro pour qu'elle se répte au lieu de l'écrire 6 fois à la suite, mais je n'y arrive pas.

J'ai essayé en remplassant sh2, sh3 etc. par sh(i) et en donnant une valeur de 2 à 6 à i mais je ne dois pas faire ce qu'il faut car je n'arrive pas à ce que ça fonctionne.

Merci d'avance

Private Sub ButtonRECHERCHE_Click()
Dim sh2, sh3, sh4, sh5, sh6
Dim c As Range, firstAddress As String
Set sh2 = Sheets("INSCRIPTIONS_2022")
Set sh3 = Sheets("INSCRIPTIONS_2023")
Set sh4 = Sheets("INSCRIPTIONS_2024")
Set sh5 = Sheets("INSCRIPTIONS_2025")
Set sh6 = Sheets("INSCRIPTIONS_2026")
ListBox1.Clear
'
' INSCRIPTIONS 2022
'
With sh2.Range("A2:A" & sh2.Range("A" & Rows.Count).End(xlUp).Row)
Set c = .Find(Me.TextBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
'LookAt:=xlWhole pour NOM précis ou LookAt:=xlPart pour NOM partiel
    If Not c Is Nothing Then
    firstAddress = c.Address
        Do
            Me.ListBox1.AddItem c.Row
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh2.Name, 4)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh2.Range("A" & c.Row).Value
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = sh2.Range("B" & c.Row).Value
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
        Me.ListBox1.AddItem
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh2.Name, 4)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = "Non inscrit"
    End If
End With
'
' INSCRIPTIONS 2023
'
With sh3.Range("A3:A" & sh3.Range("A" & Rows.Count).End(xlUp).Row)
    Set c = .Find(Me.TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Me.ListBox1.AddItem c.Row
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh3.Name, 4)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh3.Range("A" & c.Row).Value
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = sh3.Range("B" & c.Row).Value
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
        Me.ListBox1.AddItem
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh3.Name, 4)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = "Non inscrit"
    End If
End With
'
' INSCRIPTIONS 2024
'
With sh4.Range("A2:A" & sh4.Range("A" & Rows.Count).End(xlUp).Row)
    Set c = .Find(Me.TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Me.ListBox1.AddItem c.Row
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh4.Name, 4)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh4.Range("A" & c.Row).Value
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = sh4.Range("B" & c.Row).Value
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
        Me.ListBox1.AddItem
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh4.Name, 4)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = "Non inscrit"
    End If
End With
'
' INSCRIPTIONS 2025
'
With sh5.Range("A2:A" & sh5.Range("A" & Rows.Count).End(xlUp).Row)
    Set c = .Find(Me.TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Me.ListBox1.AddItem c.Row
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh5.Name, 4)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh5.Range("A" & c.Row).Value
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = sh5.Range("B" & c.Row).Value
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
        Me.ListBox1.AddItem
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh5.Name, 4)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = "Non inscrit"
    End If
End With
'
' INSCRIPTIONS 2026
'
With sh6.Range("A2:A" & sh6.Range("A" & Rows.Count).End(xlUp).Row)
    Set c = .Find(Me.TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Me.ListBox1.AddItem c.Row
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh6.Name, 4)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh6.Range("A" & c.Row).Value
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = sh6.Range("B" & c.Row).Value
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
        Me.ListBox1.AddItem
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh6.Name, 4)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = "Non inscrit"
    End If
End With
End Sub

Le 25/02/2023 à 22:03

Je précise que j'ai également essayé avec sh & i mais ça ne marche pas non plus (du moins comme je le fais)

Le 25/02/2023 à 22:23

Hello,

Petite astuce, tu crées deux onglets :un que tu nommes A et l'autre B. Et tu mets toutes tes années entre ces deux onglets

Dans ta boucle tu récupères le numéro de la feuille "A" et le numéro de la feuille "B" et tu fais une boucle allant du numéro de feuille A +1 jusqu'à numéro de feuille B-1

Tu vois le truc ?

Le 25/02/2023 à 22:35

bonjour, comme ça ?

Private Sub ButtonRECHERCHE_Click()
     Dim sh2, sh3, sh4, sh5, sh6
     Dim c As Range, firstAddress As String

     ListBox1.Clear

     For i = 2 To 6
          Set sh2 = Sheets("INSCRIPTIONS_202" & i)

          With sh2.Range("A2:A" & sh2.Range("A" & Rows.Count).End(xlUp).Row)
               Set c = .Find(Me.TextBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
     'LookAt:=xlWhole pour NOM précis ou LookAt:=xlPart pour NOM partiel
               If Not c Is Nothing Then
                    firstAddress = c.Address
                    Do
                         Me.ListBox1.AddItem c.Row
                         Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh2.Name, 4)
                         Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh2.Range("A" & c.Row).Value
                         Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = sh2.Range("B" & c.Row).Value
                         Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
               Else
                    Me.ListBox1.AddItem
                    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Right(sh2.Name, 4)
                    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = "Non inscrit"
               End If
          End With
     Next     '

End Sub

Le 25/02/2023 à 22:38

Bonsoir

non, je ne voie pas vraiment. j'ai 88 onglets dans mon programme et les onglets comportants les inscriptions ne se suivents pas.

N'est il pas possible de faire la meme chose mais avec le nom des onglets plustot que leur N° puisque les noms se terminent avec des chiffres qui se suivent.

Le 25/02/2023 à 22:49

En fait, je viens de trouver, merci.

J'ai remplacé les années en fin des noms d'onglets par une variable et ça marche.

merci encore

Le 26/02/2023 à 07:52

bonjour,

ceci est aussi une possibilité (EDIT : j'ai corrigé quelques erreurs après !!!)

Sub Macro1()     
     For i = 1 To Sheets.Count     'boucle toutes les feuilles
     Set sh2 = Sheets(i)     
     If UCase(sh2.Name) Like "INSCRIPTIONS_20##" Then     'vérifier si le nom de la feuille est comme ça (avec des majuscules ou des miniscules, pas d'importance) et avec 2 chiffres au lieu de "##"

     'le reste ....

          End If
     Next
End Sub

Le 26/02/2023 à 10:24

Merci pour ce complément.

Tout mes onglets sont en majuscule, mais je garde le principe pour une autre procédure que j'ai en tete.

Bonne journée

Rechercher des sujets similaires à "racourcir macro"