Récuperer sur une feuille plusieurs cellules de certaines onglets

[dirmon]

Bonjour à tous

J'ai mis en place une macro pour récupérer sous forme de base de données plusieurs cellules de certains onglets.

Ci-joint macro

Sub Infos2()
Dim Lig As Long
Dim Ws As Worksheet
Lig = 1
With Sheets("Synthèse Chantiers")
For Each Ws In ThisWorkbook.Sheets
If Ws.Name <> "Accueil" And Ws.Name <> "M&A" And Ws.Name <> "A" And Ws.Name <> "john" And Ws.Name <> "Patrice" Then
Lig = Lig + 1
.Cells(Lig, 1) = Ws.Name
.Cells(Lig, 2) = Ws.Range("C4").Value
.Cells(Lig, 3) = Ws.Range("J4").Value
.Cells(Lig, 4) = Ws.Range("P4").Value
.Cells(Lig, 5) = Ws.Range("C9").Value
End If
Next Ws
End With
End Sub

Sur 200 feuilles que comporte mon classeur je souhaite en exclure une centaines que je dois rajouter manuellement à chaque fois sur la ligne

If Ws.Name <> "Accueil" And Ws.Name <> "M&A" And Ws.Name <> "A" And Ws.Name <> "john" And If Ws.Name <> "Accueil" And Ws.Name <> "M&A" And Ws.Name <> "A" And Ws.Name <> "john" And Ws.Name <> "Paul" Then

Avez vous une autre solution pour traiter ce problème ?

Merci pour votre aide

 

[Pierrot93]

Re : Récuperer sur une feuille plusieurs cellules de certaines onglets

Bonjour,

peut être pourras tu t'inspirer de ceci :

Dim t() As Variant, ws As Worksheet
t = Array("Feuil3", "Feuil4")
For Each ws In Worksheets
    If Not IsError(Application.Match(ws.Name, t, 0)) Then MsgBox "trouvée..."
Next ws

mais faudra quand même renseigner les noms dans "l'array".... perso j'opterais pour préfixer les feuilles, par exemple un "@", il suffirait ensuite de n'effectuer qu'un seul test....

If ws.Name Like "@*" Then MsgBox "trouvée..."

A voir selon ton projet...

bonne journée
@+

 

[dirmon]

Re : Récuperer sur une feuille plusieurs cellules de certaines onglets

Super et Merci Pierrot93

J'ai utilisé ton deuxième exemple qui me va très bien.

A bientôt sur le forum.