Encore ces sacrées boucles !

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion WDAndCo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
WDAndCo

WDAndCo

XLDnaute Impliqué
Bonjoure le Forum

Une feuille doit se remplir toute seule.
Elles doit, parcourir tous les onglets à partir du 5eme
Le nombre de ligne est variable dans chaque onglets le nombre est en L1
Crée une ligne si la colonne Delais<>"" et si la colonne Dates Exécution est vide, et y mettre quelques informations
J'ai déjà une partie de code, mais la je bloque. Il n'y a qu'une ligne qui se crée par onglet.
Merci de modifier ce code.
Merci D'avance.
Code: 
Private Sub Worksheet_Activate()
    [A2:I1000].ClearContents
Range("A1").Value = "RECAPITULATIF des Visites EF 5A n°7"
Range("A2").Value = "N° du CR"
Range("B2").Value = "Dates"
Range("C2").Value = "Lieux"
Range("D2").Value = "Installations"
Range("E2").Value = "Points à Amortir"
Range("F2").Value = "Delais"
Range("G2").Value = "Moyen"

LP = 0 'LP = Une Ligne Plus
    For i = 5 To Sheets.Count 'Tous les onglets a partir du 5eme
    
    nf = Sheets(i).Name
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(i - 2, 1), Address:="", SubAddress:="'" & _
         nf & "'" & "!A1", TextToDisplay:=nf
    
    With Sheets(i)
    
        NL = ActiveSheet.Range("L1").Value 'Nb de ligne sur l'onglet
       
        For L = 12 To NL + 12
If ActiveSheet.Range("G" & L).Value <> "" And ActiveSheet.Range("H" & L).Value = "" Then LP = LP + 1:
   ActiveSheet.Range("A" & i - 2 + LP).Value = .Range("H6").Value:
   ActiveSheet.Range("B" & i - 2 + LP).Value = .Range("C8").Value:
   ActiveSheet.Range("C" & i - 2 + LP).Value = .Range("B12").Value:
   ActiveSheet.Range("D" & i - 2 + LP).Value = .Range("C" & L).Value:
   ActiveSheet.Range("E" & i - 2 + LP).Value = .Range("D" & L).Value:
   ActiveSheet.Range("F" & i - 2 + LP).Value = .Range("G" & L).Value

        Next L
  
    
    End With
   
Next i

    Range("A2:G2").Select
    Selection.AutoFilter
     Columns("A:G").Select
    ActiveWindow.Zoom = True
    Range("H1").Select
End Sub
Dominique
 
Trier par date Trier par votes
Re : Encore ces sacrées boucles !

Bonjour.
Vous êtes sûr que c'est ActiveSheet. qu'il faut prendre pour le test ? Ce ne serait pas plutôt le . de With Sheets(i) ?
Un conseil: passez en revue les ActiveSheet et supprimez les tous. Mettre Me à la place quand vous être sûr de devoir désigner la feuille dont c'est la Worksheet_Activate.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Bonjour le Forum
Merci Dranreb

J'ai trouvé ! ! Enfin presque.
Car il reste des petites bricoles,

1) Je n'ai plus les liens en colonne A
2) Le code n'est pas "propre" il y a une ligne de plusieurs Km

Code: 
Private Sub Worksheet_Activate()
    [A2:I1000].ClearContents
Range("A1").Value = "RECAPITULATIF des Visites EF 5A n°7"
Range("A2").Value = "N° du CR"
Range("B2").Value = "Dates"
Range("C2").Value = "Lieux"
Range("D2").Value = "N° Points"
Range("E2").Value = "Installations"
Range("F2").Value = "Points à Amortir"
Range("G2").Value = "Delais"
Range("H2").Value = "Moyen"

DL = 3 'DL = Derniere Ligne

    For i = 5 To Sheets.Count 'Tous les onglets a partir du 5eme
    
    nf = Sheets(i).Name
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(i - 2, 1), Address:="", SubAddress:="'" & _
         nf & "'" & "!A1", TextToDisplay:=nf
    
    With Sheets(i)
    
      NL = .Range("L1").Value 'Nb de ligne sur l'onglet
       
        For L = 12 To NL + 11
If .Range("G" & L).Value <> "" And .Range("H" & L).Value = "" Then ActiveSheet.Range("A" & DL).Value = .Range("H6").Value: ActiveSheet.Range("B" & DL).Value = .Range("C8").Value: ActiveSheet.Range("C" & DL).Value = .Range("B12").Value: ActiveSheet.Range("D" & DL).Value = .Range("A" & L).Value: ActiveSheet.Range("E" & DL).Value = .Range("C" & L).Value: ActiveSheet.Range("F" & DL).Value = .Range("D" & L).Value: ActiveSheet.Range("G" & DL).Value = .Range("G" & L).Value: ActiveSheet.Range("H" & DL).Value = .Range("E" & L).Value: DL = DL + 1
    
        Next L
  
    
    End With
   
Next i

    Range("A2:H2").Select
    Selection.AutoFilter
     Columns("A:H").Select
    ActiveWindow.Zoom = True
    Range("I1").Select
End Sub
 
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Bonjour.
Vous avez été un peu long à appliquer la moitié de ma recommandation, non ? N'y auriez vous pas cru ?
J'ignore pourquoi le lien ne se met pas en place. Il me faudrait pouvoir faire des essais sur le fichier joint. Peut être y aurait il lieu de supprimer préalablement les liens préexistants.
La ligne serait plus courte avec des instructions de la forme Me.Cells(DL, "D").Value = .Cells(L, "A").Value
Le mot clé Me désigne toujours l'objet qui porte le code, en l'occurrence la feuille dont c'est la Worksheet_Activate.
Cela dit vous pourriez aussi mettre une affectation par ligne, la première n'étant déjà plus juste derrière le Then, et mettre un End If derrière l'incrémentation de DL.
Vous pourriez avoir intérêt à travailler avec des tableaux: vous y gagneriez en rapidité.
 
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Bonjour le Forum, merci Dranreb

Voici la dernière mouture
Code: 
Private Sub Worksheet_Activate()
    [A1:I1000].ClearContents
Range("A1").Value = "RECAPITULATIF des Visites EF 5A n°7"
Range("A2").Value = "N° du CR"
Range("B2").Value = "Dates"
Range("C2").Value = "Lieux"
Range("D2").Value = "N° Points"
Range("E2").Value = "Installations"
Range("F2").Value = "Points à Amortir"
Range("G2").Value = "Delais"
Range("H2").Value = "Moyen"

DL = 3 'DL = Derniere Ligne

    For I = 5 To Sheets.Count 'Tous les onglets a partir du 5eme
    
    nf = Sheets(I).Name
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(I - 2, 1), Address:="", SubAddress:="'" & _
         nf & "'" & "!A1", TextToDisplay:=nf
    
        With Sheets(I)
    
      NL = .Range("L1").Value 'NL est egal le nombre de ligne sur l'onglet
       
            For L = 12 To NL + 11 'De la 1er a la derniere avec le decalage
        
            If .Range("G" & L).Value <> "" And .Range("H" & L).Value = "" Then
            ActiveSheet.Range("A" & DL).Value = .Range("H6").Value
            ActiveSheet.Range("B" & DL).Value = .Range("C8").Value
            ActiveSheet.Range("C" & DL).Value = .Range("B12").Value
            ActiveSheet.Range("D" & DL).Value = .Range("A" & L).Value
            ActiveSheet.Range("E" & DL).Value = .Range("C" & L).Value
            ActiveSheet.Range("F" & DL).Value = .Range("D" & L).Value
            ActiveSheet.Range("G" & DL).Value = .Range("G" & L).Value
            ActiveSheet.Range("H" & DL).Value = .Range("E" & L).Value
            DL = DL + 1
    
                End If ' Sinon reprends ici
    
            Next L
        
        End With
    
    Next I

    Range("A2:H2").Select
    Selection.AutoFilter
     Columns("A:H").Select
    ActiveWindow.Zoom = True
    Range("I1").Select
End Sub
Les derniers soucis sont les liens !
C'est un code que j'ai récupéré est adapté.
Je viens d’apprendre grâce a vous le :
Code: 
End If

Pour les liens je pense que :
Code: 
  nf = Sheets(I).Name
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(I - 2, 1), Address:="", SubAddress:="'" & _
         nf & "'" & "!A1", TextToDisplay:=nf
N’est pas à sa place, mais ou le mettre ?
Pour le fichier joint impossible pour l'instant car je suis boulot !

Dominique
 
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Ne dépasseriez vous pas le nombre de liens autorisés dans une feuille à force d'en ajouter des centaines toujours les mêmes sur les mêmes cellules sans jamais détruire les anciens préalablement ?
 
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Bonjour Dominique
Bonjour Dranred
Bonjour le forum

je viens de tester le code (Sans Données) et les liens sont bien créés en colonne 1 est sont effectifs.
Pour répondre à l'interrogation de Dranred une question (combien de lien crées tu ainsi ?)

Merci par avance
Amicalement
Jean Marie
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Re

je viens de me rendre compte d'un problème (si j'ai bien compris Lol)
DL = 3 'DL = Derniere Ligne

For I = 5 To Sheets.Count 'Tous les onglets a partir du 5eme

nf = Sheets(I).Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I - 2, 1), Address:="", SubAddress:="'" & _
nf & "'" & "!A1", TextToDisplay:=nf

With Sheets(I)

NL = .Range("L1").Value 'NL est egal le nombre de ligne sur l'onglet

For L = 12 To NL + 11 'De la 1er a la derniere avec le decalage

If .Range("G" & L).Value <> "" And .Range("H" & L).Value = "" Then
ActiveSheet.Range("A" & DL).Value = .Range("H6").Value
Cliquez pour agrandir...

DL = 3 ,on met donc le lien en colonne 1 ligne 3 pour la feuille 5 etc
puis dans la boucle L =12 to NL+11 on colle en Range("A" & DL), la valeur de .Range("H6").Value alors que
Cells(I - 2, 1) = Range("A" & DL)

ne peux tu mettre une feuille exemple(Feuil5) avec quelques lignes de données non confidentielles?

en espérant avoir compris lol
Bonne fin de Journée
Amicalement
Jean Marie
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Re
voila ce que j'ai modifié et qui semble fonctionner
VB: 
Private Sub Worksheet_Activate()
Dim Ws_Source As Worksheet
Dim Ws_Cible As Worksheet
Dim DL As Byte
Dim I As Byte
Dim NL As Long
Dim L As Long
      Set Ws_Cible = Me
      Application.ScreenUpdating = False
      With Ws_Cible
            [A1:I1000].ClearContents
            .Range("A1").Value = "RECAPITULATIF des Visites EF 5A n°7"
            .Range("A2").Value = "Liens"      '"N° du CR"
            .Range("B2").Value = "N° du CR"
            .Range("C2").Value = "Dates"
            .Range("D2").Value = "Lieux"
            .Range("E2").Value = "N° Points"
            .Range("F2").Value = "Installations"
            .Range("G2").Value = "Points à Amortir"
            .Range("H2").Value = "Delais"
            .Range("I2").Value = "Moyen"
      End With
      DL = 3      'DL = Derniere Ligne
      For I = 5 To Sheets.Count      'Tous les onglets a partir du 5eme
            Set Ws_Source = Sheets(I)
            With Ws_Source
                  Ws_Cible.Hyperlinks.Add Anchor:=Ws_Cible.Cells(I - 2, 1), Address:="", SubAddress:="'" & _
                          .Name & "'" & "!A1", TextToDisplay:=.Name

                  NL = Sheets(I).Range("L1").Value      'NL est egal le nombre de ligne sur l'onglet

                  For L = 12 To NL + 11      'De la 1er a la derniere avec le decalage

                        If .Range("G" & L).Value <> "" And .Range("H" & L).Value = "" Then
                              Ws_Cible.Range("B" & DL).Value = .Range("H6").Value
                              Ws_Cible.Range("C" & DL).Value = .Range("C8").Value
                              Ws_Cible.Range("D" & DL).Value = .Range("B12").Value
                              Ws_Cible.Range("E" & DL).Value = .Range("A" & L).Value
                              Ws_Cible.Range("F" & DL).Value = .Range("C" & L).Value
                              Ws_Cible.Range("G" & DL).Value = .Range("D" & L).Value
                              Ws_Cible.Range("H" & DL).Value = .Range("G" & L).Value
                              Ws_Cible.Range("I" & DL).Value = .Range("E" & L).Value

                              DL = DL + 1

                        End If      ' Sinon reprends ici

                  Next L

            End With
Next I
      With Ws_Cible
            ActiveWindow.Zoom = 200
            .Range("A2:I2").AutoFilter
      End With
      Application.ScreenUpdating = True
End Sub

Dans l'attente
Amicalement
Jean Marie
 
Vote positif 0 Vote négatif
Re : Encore ces sacrées boucles !

Bonjour Dranred, Jean Marie et le Forum

Merci, et pardon pour ce retard.
J'ai résolus le problème.

Le problème était la mauvaise position du lien dans mes boucles !

Encore merci.
Code: 
Private Sub Worksheet_Activate()

If MsgBox("Confirmez vous la M.A.J du tableau ?", vbYesNo, "Confirmation") = vbNo Then Exit Sub

    [A2:I1000].ClearContents
Range("A1").Value = "RECAPITULATIF des Visites EF 5A n°7"
Range("A2").Value = "N° du CR"
Range("B2").Value = "Dates"
Range("C2").Value = "Lieux"
Range("D2").Value = "N° Points"
Range("E2").Value = "Installations"
Range("F2").Value = "Points à Amortir"
Range("G2").Value = "Delais"
Range("H2").Value = "Moyen"

DL = 3 'DL = Derniere Ligne

    For I = 5 To Sheets.Count 'Tous les onglets a partir du 5eme
  
    nf = Sheets(I).Name
      
    With Sheets(I)
    
      NL = .Range("L1").Value 'Nb de ligne sur l'onglet
       
    For L = 12 To NL + 11
If .Range("G" & L).Value <> "" And .Range("H" & L).Value = "" Then

ActiveSheet.Hyperlinks.Add Anchor:=Cells(DL, 1), Address:="", SubAddress:="'" & _
         nf & "'" & "!A1", TextToDisplay:=nf
         
    ActiveSheet.Range("B" & DL).Value = .Range("C8").Value
    ActiveSheet.Range("C" & DL).Value = .Range("B12").Value
    ActiveSheet.Range("D" & DL).Value = .Range("A" & L).Value
    ActiveSheet.Range("E" & DL).Value = .Range("C" & L).Value
    ActiveSheet.Range("F" & DL).Value = .Range("D" & L).Value
    ActiveSheet.Range("G" & DL).Value = .Range("G" & L).Value
    ActiveSheet.Range("H" & DL).Value = .Range("E" & L).Value
    DL = DL + 1
    
    End If
    
        Next L
        
    End With
    
Next I

    Range("A2:H2").Select
    Selection.AutoFilter
     Columns("A:H").Select
    ActiveWindow.Zoom = True
    Range("I1").Value = DL
    Range("I1").Select
End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
302
Gestionnaire_rh
G
reska
  • Question Question
XL 2021 création d'onglets en masse depuis un modele
Réponses
6
Affichages
79
Phil69970
Phil69970
S
  • Question Question
XL 2016 Problème dans la création d'une liste
Réponses
2
Affichages
355
Stéphane_1
S
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
69
piga25
piga25
D
  • Question Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
1 K
AtTheOne
AtTheOne
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
pompaero
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
446
pompaero
pompaero
T
  • Question Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
S
  • Résolu(e)
XL 2016 Coller nom classeur sur plage cellules
Réponses
9
Affichages
93
safranien
S
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
468
ph.vanne
ph.vanne
F
  • Résolu(e)
Microsoft 365 Commentaire cellule dans TextBox dans UserForm
Réponses
4
Affichages
603
Francky79
F
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
439
loreak
L
Z
  • Question Question
Microsoft 365 Ajouter une étiquette de confidentialité via macro
Réponses
4
Affichages
2 K
onobyone
O
Philou0607
  • Question Question
XL 2016 Signature mail outlook avec VBA
Réponses
5
Affichages
805
wDog66
wDog66
B
  • Question Question
Microsoft 365 formulaire VBA problème
Réponses
3
Affichages
859
herve62
herve62
Z
  • Résolu(e)
XL 2019 Problème liens Hypertexte
2
Réponses
16
Affichages
2 K
Zapinet
Z
O
  • Question Question
Microsoft 365 Excel [VBA]. Erreur d’exécution 424 Objet requis sur une concaténation
Réponses
3
Affichages
440
Oneida
Oneida
A
  • Question Question
XL 2016 Sous-totaux ou WorksheetFunction.Sum
Réponses
2
Affichages
715
Aldonanou
A
R
  • Résolu(e)
XL 2016 Un petit coup de main pour un code VBA
Réponses
11
Affichages
809
ReneDav14000
R
Retour