boucle de fermeture

[BIL boud]

bonjour
jai cree un programme qui va recuperer des donnees en fonction d'une variable dans chaque feuilles qui se trouve dans le classeur
le programe marche mais le probleme c que a chque fois je clique sur le bouton le programme refait le tout

exemple

par ex jai enregistre des donnees dans mes feuilles , au premier clic sur le bouton le programme fonctionne mais si je reclique pour la 2 eme fois il vas refaire l'operation mais en continue (des doublure)

voici mon programme ,

sub tst ()
For k = 2 To 200
For j = 2 To Worksheets.Count

If Worksheets(j).Cells(k - 1, 1) = "NOM" Then
dlig2 = Range("A65536").End(xlUp).Row + 1

Cells(dlig2, 1) = Worksheets(j).Cells(k - 1, 2)
End If
Next
Next



End Sub

 

[Robert]

Bonjour BIL, bonjour le forum,

Pas sûr que ça résolve ton problème mais au moins on sait où on va avec ton code modifié :

Sub tst()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim K As Byte 'déclare la variable K (incrément)
Dim J As Byte 'déclare la variable J (incrément)

Set OD = Worksheets("Feuil1") 'définit l'onglet destination (à adapter à ton cas)
For K = 1 To 199 'boucle 1 : sur toutes les lignes K de 1 à 199 (j'ai pas compris pourquoi une boucle de 2 à 200 avec K-1 ?!...)
    For J = 2 To Worksheets.Count 'boucle 2 : sur tous les onglets J du classeur (en partant du second)
        Set OS = Worksheets(J) 'définit l'onglet source OS
        If OS.Cells(K, 1) = "NOM" Then 'condition : si la cellule en ligne K colonne 1 de l'onglet de la boucle 2 vaut "NOM"
            dlig2 = OD.Range("A65536").End(xlUp).Row + 1 'définit la première cellule vide de la colonne A de l'onglet destination
            OD.Cells(dlig2, 1) = OS.Cells(K, 2) 'renvoie dans cette cellule la valeur de la cellule ligne K colonne 2 de l'onglet source
        End If 'fin de la condition
    Next J 'prochain onglet de la boucle 2
Next K 'prochaine ligne de la boucle 1
End Sub

 

[job75]

Bonjour BIL boud, Robert,

Il vaut mieux utiliser des tableaux VBA, c'est beaucoup plus rapide :

Sub test()
Dim i&, tablo, j&, n&, resu()
For i = 2 To Worksheets.Count
    tablo = Worksheets(i).UsedRange.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For j = 1 To UBound(tablo)
        If UCase(tablo(j, 1)) = "NOM" Then
            n = n + 1
            ReDim Preserve resu(1 To n)
            resu(n) = tablo(j, 2)
        End If
Next j, i
'---restitution---
With Worksheets(1).[A2] 'adaptable
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    If n Then .Resize(n) = Application.Transpose(resu) 'Transpose limitée à 65536 lignes
    .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
End With
End Sub

A+

 

[BIL boud]

Bonjour BIL, bonjour le forum,

Pas sûr que ça résolve ton problème mais au moins on sait où on va avec ton code modifié :

Sub tst()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim K As Byte 'déclare la variable K (incrément)
Dim J As Byte 'déclare la variable J (incrément)

Set OD = Worksheets("Feuil1") 'définit l'onglet destination (à adapter à ton cas)
For K = 1 To 199 'boucle 1 : sur toutes les lignes K de 1 à 199 (j'ai pas compris pourquoi une boucle de 2 à 200 avec K-1 ?!...)
    For J = 2 To Worksheets.Count 'boucle 2 : sur tous les onglets J du classeur (en partant du second)
        Set OS = Worksheets(J) 'définit l'onglet source OS
        If OS.Cells(K, 1) = "NOM" Then 'condition : si la cellule en ligne K colonne 1 de l'onglet de la boucle 2 vaut "NOM"
            dlig2 = OD.Range("A65536").End(xlUp).Row + 1 'définit la première cellule vide de la colonne A de l'onglet destination
            OD.Cells(dlig2, 1) = OS.Cells(K, 2) 'renvoie dans cette cellule la valeur de la cellule ligne K colonne 2 de l'onglet source
        End If 'fin de la condition
    Next J 'prochain onglet de la boucle 2
Next K 'prochaine ligne de la boucle 1
End Sub

merci

mais ca marche ps im fait le mm problme que celui de mon programme

 

[BIL boud]

Bonjour BIL, bonjour le forum,

Pas sûr que ça résolve ton problème mais au moins on sait où on va avec ton code modifié :

Sub tst()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim K As Byte 'déclare la variable K (incrément)
Dim J As Byte 'déclare la variable J (incrément)

Set OD = Worksheets("Feuil1") 'définit l'onglet destination (à adapter à ton cas)
For K = 1 To 199 'boucle 1 : sur toutes les lignes K de 1 à 199 (j'ai pas compris pourquoi une boucle de 2 à 200 avec K-1 ?!...)
    For J = 2 To Worksheets.Count 'boucle 2 : sur tous les onglets J du classeur (en partant du second)
        Set OS = Worksheets(J) 'définit l'onglet source OS
        If OS.Cells(K, 1) = "NOM" Then 'condition : si la cellule en ligne K colonne 1 de l'onglet de la boucle 2 vaut "NOM"
            dlig2 = OD.Range("A65536").End(xlUp).Row + 1 'définit la première cellule vide de la colonne A de l'onglet destination
            OD.Cells(dlig2, 1) = OS.Cells(K, 2) 'renvoie dans cette cellule la valeur de la cellule ligne K colonne 2 de l'onglet source
        End If 'fin de la condition
    Next J 'prochain onglet de la boucle 2
Next K 'prochaine ligne de la boucle 1
End Sub

super
ca marche
merci

est il possible d'ajouter une boucle pour le programme que jai cree ?