[XL-2007] récupération données sur différentes feuilles du classeur

[vaneb]

Bonjour,

Sur une feuille Excel, j'ai entre 1 et 4 valeurs différentes (s1,s2,s3 et s4) en colonne A. Chaque valeur correspond au nom d'une feuille du classeur.
J'aimerais créer une macro permettant de récupérer, pour chaque ligne sur laquelle la valeur est située, les données de la feuille correspondant à la valeur.
La macro que j'ai créée ne marche que si les 4 valeurs ont été rentrées, comment faire pour qu'il passe à l'autre valeur si l'une d'elles n'existent pas?

Voici ma macro:

Code :

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
 For Each cel In Selection
'pour chaque société présente en colonne A, calculer les formules en reprenant le nom des sociétés
 If Cells.Find(What:="s1", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate Then
        ActiveCell.Select
        ActiveCell.Offset(0, 1).FormulaR1C1 = "=COUNTIF('s1'!R2C8:R1500C8,"">0"")"
 
  End If
 
 Next cel
For Each cel In Selection
 If Cells.Find(What:="s2", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate Then
        ActiveCell.Select
 ActiveCell.Offset(0, 1).FormulaR1C1 = "=COUNTIF(s2!R2C8:R1500C8,"">0"")"
 
 End If
 
 If Cells.Find(What:="s3", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate Then
        ActiveCell.Select
        ActiveCell.Offset(0, 1).FormulaR1C1 = "=COUNTIF('s3 '!R2C8:R1500C8,"">0"")"
 
 End If
 
 If Cells.Find(What:="s4", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate Then
        ActiveCell.Select
    ActiveCell.Offset(0, 1).FormulaR1C1 = "=COUNTIF('s4'!R2C8:R1500C8,"">0"")"
 
 End If
  Next cel

Merci d'avance pour votre aide.

[gFZT82]

Bonjour,

Voici une solution utilisant la méthode FIND.
Les 4 noms de société sont inscrits dans un tableau (Societe).
Une boucle sur ces 4 noms permet d’effectuer une recherche dans la feuille "Feuil1", colonne A.
Si la valeur est trouvée, on inscrit dans la cellule adjacente (colonne B) la formule reprenant
le nom de la société pour nom de feuille.
Avec la méthode FINDNEXT, on poursuit la recherche débutée avec la méthode Find afin de rechercher une éventuelle cellule qui correspond aux mêmes critères.

Code :

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
 
Option Explicit
Sub Test()
Dim DerLig As Long
Dim Ws1 As Worksheet
Dim MaPlage As Range, cel As Range
Dim Societe
Dim i As Byte
Dim Valeur As Range
Dim firstAddress As String
 
    Set Ws1 = Worksheets("Feuil1") 'A adapter
    DerLig = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    Set MaPlage = Ws1.Range("A1:A" & DerLig)
    Societe = Array("s1", "s2", "s3", "s4")
    For i = 0 To UBound(Societe)
        'Pour chaque société du tableau "Societe", rechercher sa présence en colonne A de la feuille 1.
        'Si cette société est trouvée, inscrire dans la cellule adjacente (colonne B) la formule reprenant _
        le nom de la société pour nom de feuille.
        Set Valeur = MaPlage.Find(What:=Societe(i), LookIn:=xlValues, LookAt:=xlPart)
        If Not Valeur Is Nothing Then
            firstAddress = Valeur.Address
            Do
                Valeur.Offset(0, 1).Formula = "=COUNTIF('" & Worksheets(Societe(i)).Name & "'!H8:H1500,"">0"")"
                Set Valeur = MaPlage.FindNext(Valeur)
            Loop While Not Valeur Is Nothing And Valeur.Address <> firstAddress
        End If
    Next i
 
    Set Valeur = Nothing
    Set MaPlage = Nothing
    Set Ws1 = Nothing
 
End Sub

Cordialement.