[VBA Excel 2003] Dernières feuilles

Résolu
nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   -  
nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Voilà, je possède plusieurs feuilles dans mon classeur. A l'aide du code qui suit, je réalise une recherche dans chaque page d'un élément donné en cellule C2 de ma feuille nommée« extraction »

Sub recherche()
Dim x As Range, l As Integer, c As Integer, maref As String, i As Integer
Worksheets("Extraction").Range("C6:G200").ClearContents
maref = ThisWorkbook.Worksheets("Extraction").Range("C2")
i = 4
For Each wsk In Worksheets
  If wsk.Name = "Extraction" Then GoTo suivant
  If wsk.Name = "Data" Then GoTo suivant
  If wsk.Name = "Graphiques" Then GoTo suivant
  With wsk.Cells
      Set x = .Find(maref, , xlValues, xlWhole)
  End With
    If Not x Is Nothing Then
      l = x.Row
      c = x.Column
      With Worksheets("Extraction")
         i = i + 1
        .Cells(i, 3) = wsk.Name
        .Cells(i, 4) = wsk.Cells(l, c + 3)
        End With
    End If
suivant:
Next wsk
End Sub


Je souhaiterais faire la même opération mais seulement sur les 50 dernières feuilles de mon fichier. Le nombre de feuille varie tous les jours, n'étant jamais inférieur à 50 mais des fois bien supérieur à 100.
N'étant pas bien caler au niveau VBA, je n'arrive pas à trouver le bout de code qui me permettrait cette opération.

Merci d'avance pour votre aide,

7 réponses

  1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Salut,
    Peut être en considérant l'ordre des feuilles grâce à leur indice, comme ceci :
    Et évite les goto inutiles!!

    Dim IndFeuil As Integer
    
    For IndFeuil = ThisWorkbook.Worksheets.Count To (ThisWorkbook.Worksheets.Count - 50) Step -1
        If Sheets(IndFeuil).Name <> "Extraction" And Sheets(IndFeuil).Name <> "Data" Sheets(IndFeuil).Name <> "Graphiques" Then
            With Sheets(IndFeuil)
                'bla bla bla
                'le reste de ton code ici
        End If
    Next

    Testes et dis...
    0
  2. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
     
    Je n'arrive pas à faire fonctionner ton bout de code avec le mien.
    A vrai dire je ne sais pas trop quoi remplacer dans le mien et tout.
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Voici ton code adapté :
      Sub recherche()
      Dim x As Range, l As Integer, c As Integer, i As Integer, IndFeuil As Integer
      Dim PremFeuil As Integer, DernFeuil As Integer
      Dim maref As String
      
      'Numéro d'indice de la première feuille à traiter
      'ici : dernière feuille du classeur
      PremFeuil = ThisWorkbook.Worksheets.Count
      'Numéro d'indice de la dernière feuille à traiter
      'ici : dernière feuille du classeur - 50
      DernFeuil = PremFeuil - 50
      'ce code ne change pas, il est de toi...
      Worksheets("Extraction").Range("C6:G200").ClearContents
      maref = ThisWorkbook.Worksheets("Extraction").Range("C2")
      i = 4
      'On va boucler sur les indices de feuilles, de la dernière à la 50ème pénultième
      For IndFeuil = PremFeuil To DernFeuil Step -1
          'test sur le nom de la feuille, s'il est différent de Extraction, Data ou graphiques alors.......
          If Sheets(IndFeuil).Name <> "Extraction" And Sheets(IndFeuil).Name <> "Data" And Sheets(IndFeuil).Name <> "Graphiques" Then
              'on traite la-dite feuille avec ton code
              With Sheets(IndFeuil).Cells
                  Set x = .Find(maref, , xlValues, xlWhole)
              End With
                  If Not x Is Nothing Then
                      l = x.Row
                      c = x.Column
                      With Worksheets("Extraction")
                          i = i + 1
                          .Cells(i, 3) = wsk.Name
                          .Cells(i, 4) = wsk.Cells(l, c + 3)
                      End With
                  End If
          End If
      Next
      End Sub

      J'ai commenté.
      J'avais oublié un "AND" dans mon test précédent et donc ça ne pouvait pas fonctionner...
      0
  3. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
     
    Je crois y être arrivé.
    Voici mon code :

    Sub recherche()
    Dim nbVal As Long
    Dim x As Range, l As Integer, c As Integer, maref As String, i As Integer
    Dim IndFeuil As Integer
    Worksheets("Extraction").Range("C6:G200").ClearContents
    maref = ThisWorkbook.Worksheets("Extraction").Range("C2")
    i = 4
    For IndFeuil = ThisWorkbook.Worksheets.Count To (ThisWorkbook.Worksheets.Count - 50) Step -1
    If Sheets(IndFeuil).Name <> "Extraction" And Sheets(IndFeuil).Name <> "Data" And Sheets(IndFeuil).Name <> "Graphiques" Then
    With Sheets(IndFeuil).Cells
          Set x = .Find(maref, , xlValues, xlWhole)
      End With
        If Not x Is Nothing Then
          l = x.Row
          c = x.Column
          With Worksheets("Extraction")
             i = i + 1
            .Cells(i, 3) = Sheets(IndFeuil).Name
            .Cells(i, 4) = Sheets(IndFeuil).Cells(l, c + 3)
            End With
        End If
        End If
    Next
    End Sub


    MERCI
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Ben oui bravo!
      A+ et de rien!
      0
  4. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
     
    Merci encore,

    J'aurais juste une petite question supplémentaire.
    J'ai créé un graphique sur cette feuille "Extraction".
    Je voudrais que mon titre de graphique prenne la valeur de la cellule C2 juste après la recherche donc juste après l'éxécution du code précédent.
    Comment dois-je procéder ? Quel est le code à mettre ?
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      J'ai créé un graphique sur cette feuille "Extraction". Par macro?
      Si oui donne le code...
      Si non, si c'est manouel, tu peux le mettre tout seul non?

      Ps : j'y connais pas grand chose en graph, mais n'hésite pas, je chercherais...
      0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
     
    Le graphique est créé manuellement mais je voudrais juste que le titre change avec la valeur de la cellule C2 après la recherche.
    J'ai réussi avec une formule. Le titre se change mais avant la recherche. Dès que j'entre la nouvelle donnée dans la cellule C2 le titre se modifie alors que le graphique n'est pas à jour avec les nouveaux paramètres.
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Le plus simple serait de connaitre le "nom" de ton graph.
      Mais, sans le connaître, s'il n'y en a qu'un dans ta feuille extraction, tu peux faire comme ceci à ajouter à la fin de ta macro :
      Dim Titre As String
      Dim Obj As Object
      
      Titre = Range("C2")
      For Each Obj In Sheets("Extraction").ChartObjects
          If Left(Obj.Name, 5) = "Chart" Then
              Obj.Activate
              Exit For
          End If
      Next
      With ActiveChart
          .ChartTitle.Characters.Text = Titre
      End With
      0
  7. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
     
    J'ai trouvé ca y'est ^^

    Sub Macro 2()
    
        Application.Run "Fichier!recherche" 'Lance la macro recherche'
        ActiveSheet.ChartObjects("Nom du graph").Activate 
        ActiveChart.ChartArea.Select
        With ActiveChart
            .HasTitle = True
            .ChartTitle.Characters.Text = Range("C2")
        End With
    End Sub
    0
  8. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
     
    Du coup maintenant j'ai encore un autre truc à faire.
    J'ai chercher un peu partout mais je trouve pas.
    En fait je voudrais que certains points de ma courbe soit en rouge.
    Ces points correspondraient aux données en rouge et en gras dans la colonne utilisé pour la courbe.
    Bien entendu ces données en rouge et gras ne sont pas toujours les mêmes points. Ceux-ci difère en fonction de ma recherche.
    Une idée grand pijaku (ou quelqu'un d'autre) ?? :)
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Je veux bien continuer, mais j'ai besoin d'infos...
      Peux tu faire une copie de ta feuille Extraction (clic droit sur l'onglet de la feuille/Déplacer ou copier, cocher "créer une copie", dans le classeur : nouveau classeur) tu enregistres ce nouveau classeur, en remplacant les données confidentielles par de simples noms. enregistre au format Excel 97-2003, .xls. Ensuite tu nous le transmet en utilisant un service de pièce jointe comme cjoint.com ou cijoint.fr.
      0
    2. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
       
      Ok je vais faire ceci. Ca risque d'être un peu long.
      merci pour tout.
      0
    3. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
       
      Voila ;

      http://www.cijoint.fr/cjlink.php?file=cj201107/cijian8nYJ.xls
      0
    4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Désolé. Je ne sais pas si ce que tu demandes est réalisable...
      A mon avis, tu devrais ouvrir un nouveau sujet; celui ci est résolu et la nouvelle question n'a rien à voir.
      Sorry
      0
    5. nightsheart Messages postés 319 Date d'inscription   Statut Membre Dernière intervention   30
       
      Pas de soucis. Merci pour tout.
      0