XL 2016 VBA - réplication code liste

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 !

james7734

XLDnaute Junior
Bonjour à tous,
Je possède un code qui me permet de récupérer depuis l'onglet 'Notes' des chiffres et les noms que je place en colonne B et C (à partir de la 9è ligne). J'aimerais tout simplement dupliquer la macro et faire exactement pareil mais en plaçant en D et E au lieu de B & C et en modifiant la boucle "For i = 11 To 1000 Step 8" en "For i = 14 To 1000 Step 8".
Je souhaite que les "2" macros s’exécutent en même temps (ne pas remplacer la macro présente).

Merci!

VB:
Private Sub Worksheet_Change(ByVal Target As Range)

    lastline_name2 = Feuil8.Range("B" & Rows.Count).End(xlUp).Row
    
    If Not Intersect(Target, Feuil8.Range("C5")) Is Nothing Then
        If lastline_name2 > 9 Then
            Range(Cells(9, 2), Cells(lastline_name2, 3)).ClearContents
        End If
        
        For i = 11 To 1000 Step 8
            If Range("C5") = Sheets("Notes").Cells(15, i) Then
                lastline_notes2 = Sheets("Notes").Range("A" & Rows.Count).End(xlUp).Row
                For j = 19 To lastline_notes2
                If IsNumeric(Sheets("Notes").Cells(j, i)) = True Then
                
                    If Sheets("Notes").Cells(j, i) >= Feuil8.Range("C3").Value Then
                        lastline_name2 = Range("B" & Rows.Count).End(xlUp).Row
                        Cells(lastline_name2 + 1, 2) = Sheets("Notes").Cells(j, 2)
                        Cells(lastline_name2 + 1, 3) = Sheets("Notes").Cells(j, i)
                    End If
                End If
                Next j
            End If
        Next i
    End If
End Sub
 
Bonjour James,
Il vous suffit de dupliquer le code après le premier.
De changer "B" en "D", "C" en "E", de changer les numéros de colonne 2 et 3 par 4 et 5, de changer le
For i = 11 To 1000 Step 8 par For i = 14 To 1000 Step 8 comme vous l'avez dit.
Ou encore optimisé via une seconde macro, mais ce serait se compliquer la vie.
 
Bonjour James,
Il vous suffit de dupliquer le code après le premier.
De changer "B" en "D", "C" en "E", de changer les numéros de colonne 2 et 3 par 4 et 5, de changer le
For i = 11 To 1000 Step 8 par For i = 14 To 1000 Step 8 comme vous l'avez dit.
Ou encore optimisé via une seconde macro, mais ce serait se compliquer la vie.
C'est ce que j'avais fait dans un 1er temps mais je pensais qu'il existait assez simple permettant d'optimiser. Merci pour votre aide, je vais répliquer le code , merci!
 
Bonsoir james7734, sylvanu,

Je propose cette optimisation du code VBA (non testée).

Attention : le dernier .Cells(j ,i) doit être adapté !
VB:
Option Explicit

'Variables de dernière ligne :
'  dl1 : lastline_notes2 ; dernière ligne, selon colonne A
'  dl2 : lastline_name2 ; dernière ligne, selon colonne B
'  dl3 : dernière ligne, selon colonne D
'  dlg : max de dl2 et dl3, pour effacer anciennes données

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Feuil8.[C5]) Is Nothing Then Exit Sub
  Dim nlm&, dl1&, dl2&, dl3&, dlg&, i%, j&
  nlm = Rows.Count: Application.ScreenUpdating = 0
  dl2 = Feuil8.Cells(nlm, 2).End(3).Row: dlg = dl2
  dl3 = Feuil8.Cells(nlm, 4).End(3).Row: If dl3 > dl2 Then dlg = 3
  If dlg > 9 Then [B9].Resize(dlg - 8, 2).ClearContents
  With Worksheets("Notes")
    dl1 = .Cells(nlm, 1).End(3).Row 'doit être avant la boucle For i !!!
    For i = 11 To 1000 Step 8
      If [C5] = .Cells(15, i) Then
        For j = 19 To dl1
          If IsNumeric(.Cells(j, i)) Then
            If .Cells(j, i) >= Feuil8.[C3] Then
              dl2 = dl2 + 1
              Cells(dl2, 2) = .Cells(j, 2): Cells(dl2, 3) = .Cells(j, i)
              If i > 13 Then
                'comme je ne sais pas bien quelles sont les données,
                'il faudra sans doute adapter le .Cells(j, i) ici :
                Cells(dl2, 4) = .Cells(j, 4): Cells(dl2, 5) = .Cells(j, i)
              End If
            End If
          End If
        Next j
      End If
    Next i
  End With
End Sub
soan
 
Bonjour James,
Il vous suffit de dupliquer le code après le premier.
De changer "B" en "D", "C" en "E", de changer les numéros de colonne 2 et 3 par 4 et 5, de changer le
For i = 11 To 1000 Step 8 par For i = 14 To 1000 Step 8 comme vous l'avez dit.
Ou encore optimisé via une seconde macro, mais ce serait se compliquer la vie.
Rebonjour,

J'ai bien tenté de le dupliquer mais il s'avère que rien ne se passe. J'ai l'impression que c'est au niveau du 'For i = 14 To 1000 Step 8' puisque lorsque je laisse avec '11' le code marche bien. Sauf que mes données se situe bien à partir de la colonne 14 ! (j'en ai également en colonne 11 mais je veux celles à partir de 14). Je ne comprends pas...
 
- 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

Réponses
5
Affichages
281
Réponses
4
Affichages
206
Réponses
8
Affichages
238
Réponses
2
Affichages
127
Réponses
2
Affichages
214
Réponses
8
Affichages
485
Réponses
10
Affichages
295
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
524
Retour