Discussion :

[flooki]

tableaux.xlsm
Bonjour,
j'ai essayé de recopier un code et l'adapter a mon besoin , je veux extraire des lignes d'un tableaux , a partir d'un critère sur une colonne , càd de selectionner une valeur dans la liste roulante qui j'ai crée de ( 1 à 54 ) et s'il existe dans la colonne hauteur , vas prendre toute la ligne et le copier dans une autre feuille , mais le code ne marche pas trés bien , et je voudrais aussi de remplacer la liste roulante par une valeur entrée avec un écart .
merci en avance de votre aide

[mjpmjp]

bonjour,
tu as déjà un code pour cibler les valeurs avec écart dans ce code tu peu remplacer la couleur par un lien vers le code d'extraction ...



les déclarations

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Private LigneNB As Double
Private ValeurOrigin As Integer
Private ValeurMaxi As Integer
Private ValeurMini As Integer
Private ValeurEcart As Integer
Private Data As Integer
'-------------------------- table destination
Private LigneNBDest As Double

le nouveau code ( Extraction )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
 
Private Sub CommandButton2_Click()
    'nombre de ligne de la table
    LigneNB = Range("F1").End(xlDown).Row
    'les écarts de valeur
    ValeurOrigin = Range("J4").Value
    ValeurEcart = Range("K4").Value
    ValeurMaxi = ValeurOrigin + ValeurEcart
    ValeurMini = ValeurOrigin - ValeurEcart
    'efface les couleurs
    Range("J4").Select
    Selection.Copy
    Range("F2:F" & LigneNB).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J4").Select
    'boucle
    For n = 2 To LigneNB
        Data = Range("F" & n).Value
        Select Case Data
            Case Is = ValeurOrigin
                ExtraireLigne (n)
            Case Is = ValeurMaxi
                ExtraireLigne (n)
            Case Is = ValeurMini
                ExtraireLigne (n)
            Case Is > ValeurMini
                If Data < ValeurMaxi Then ExtraireLigne (n)
            Case Else
                Range("F" & n).Interior.ColorIndex = 0
        End Select
    Next n
End Sub
Private Sub ExtraireLigne(LigneNum As Double)
    'copier la ligne
    Range("A" & LigneNum & ":G" & LigneNum).Select
    Selection.Copy
    '----- destination de la ligne
    'nombre de ligne de la table de destination
    If Range("O2").Value = "" Then
        LigneNBDest = 2
    Else
        LigneNBDest = Range("O1").End(xlDown).Row + 1
    End If
    '
    Range("O" & LigneNBDest).Select
    'coller la ligne
    ActiveSheet.Paste
End Sub

@+JP

[flooki]

j'ai essaye de faire ça mais mon code d'extraction est incomplet , il m'affiche pas les lignes qui correspond dans la nouvelle feuille

[mjpmjp]

bonjour,
affiche ton code

@+JP

[flooki]

rebonjour ,
merci bcp pour votre aide , ton code ca me va vraiment bien , la maintenant je vais essaye avant d'extraire les données dans un nouvelle tableau , le code affiche une fenetre de controle qui contient les largeur et selectioner quelle ligne je veux extraire en cochant la largeur .
à la palce de numéro j'aurais les largeur qui correspond au hauteur choisis et aprés extraire la ligne qui correspond a la largeur cocher . si vous avez une idée comment faire ca .
merci en avance

[flooki]

est ce que vous pouvez me mettre le fichier en piece jointe svp .
merci

[mjpmjp]

bonjour,
si j'ai bien compris , tu ne veut pas extraire toutes les lignes , mais choisir dans ces lignes celles que tu veut extraire.

dans le code qui écrit les lignes , tu modifies la destination

en fait , la nouvelle destination est un contrôle liste avec les options de sélection !!!

et de là tu écris dans la table

@+JP