Discussion :

[laurasoe]

Bonjour,

Y a peu de temps j'ai fait une macro qui automatise les copier/coller-transpose d'une feuille(MACRO) à une autre (CRNT MOD).
Normalement elle doit coller les éléments sélectionnés à un endroit précis.

J'ai des valeurs dans une ListBox, je les sélectionne (une ou plusieurs, en fonction des choix dans ma listBox) je les recherche dans ma feuille "CRNT MOD" et une fois la ligne trouvé, je copie ma sélection de la feuille MACRO vers la CRNT MOD à la ligne en dessous.

Je sais pas si j'ai été claire, je pense que le code va s'expliquer par lui-même

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
Sub Transpose()
' transpose Macro
 
 
Dim RefChoix As String
Dim adCell As Range
Dim lig As Integer
 
RefChoix = UserForm1.FTre
 
Sheets("MACRO").Range("A2:C" & Sheets("MACRO").Range("A" & Rows.Count).End(xlUp).Row).Copy
 
'cherche la ligne ou ya la référence
Set adCell = Sheets("CNRT MOD").Cells.Find(RefChoix)
 
If Not adCell Is Nothing Then
    'selectionner ligne+1
    lig = adCell.Row + 1
    'Transpose
    Sheets("CNRT MOD").Cells(lig, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
    Unload UserForm1
Else
    MsgBox "La référence " & RefChoix & " n'est pas présente dans la feuille CRNT MOD." _
    & vbCrLf & "Traitement annulé.", vbCritical, "Erreur"
    Unload UserForm1
    End
End If
 
ActiveWorkbook.Worksheets("MACRO").Range("A:C").clear
Application.ScreenUpdating = True
 
End Sub

avec FTre qui vient de l'userform:

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
Private Sub CommandButton3_Click()
 
'Filtre
Dim Derlg As Range, x As Long
Dim FTre()
ReDim FTre(ListBox2.ListCount)
Set Derlg = Range("A" & Rows.Count).End(xlUp)
  For x = 0 To ListBox2.ListCount - 1
    FTre(x) = ListBox2.List(x, 0)
  Next x
Range("A1", Derlg).AutoFilter Field:=1, Criteria1:=FTre, Operator:=xlFilterValues
 
'Cacher le userform
UserForm1.Hide
 
End Sub

En faite la chose que je ne comprend c'est que la macro s'exécute et tout mais ne colle pas les éléments au bon endroit ....


Est-ce que je pourrai avoir un peu d'aide s'il vous plaît ?


Bonne journée
Laura

[parmi]

Bonjour,

Il y a quelque chose que je ne comprends pas.

Tu déclares un Tableau FTre à l'intérieur du code d'un bouton
Et tu affectes à une chaîne RefChoix UserForm1.FTre...

Est-ce que tu as aussi un contrôle qui se nomme FTre ?

[laurasoe]

Bonjour,

Un tableau ? Quel tableau ? là j'avoue je ne comprends pas...,
les choix des articles on les conserve pour filtrer une autre feuille (CRNET CDE) en fonction de ces articles là.

Et tu affectes à une chaîne RefChoix UserForm1.FTre...

nope enfin je ne sais pas! (A force de chercher et à l'aide d'une personne on a trouvé ce que je voulais faire de cette manière pour le bouton valider (c'est à dire filtrer une feuille en fonction des éléments choisi dans ma listbox), le principal c'est que ça marche )
Sinon quelle chaîne voyez-vous ?

Est-ce que tu as aussi un contrôle qui se nomme FTre ?

Je pense que non (désolé vraiment grande débutante je suis ...)


Merci et bonne journée!

[SfJ5Rpw8]

bonjour,

et elle les colles ou tes éléments ta macro ?

c'est peu être du au fait que tu utilise mal les objets Range et cells ...

il faut éviter de ce contenter de travailler sur la feuille active ... et donc à chaque fois que tu utilise un objet range , Cells ... il faut le précéder de ta feuille.

par exemple

Code :

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

1
2
3
4
5
6
7
 
dim shCnr as worksheet
set shCnr = ThisWorkBook.Sheets("CNRT MOD")
 
'Et à partir de la chaque fois que tu veux accéder à ta feuille CNRT.... tu utilise l'objet shCnr
 
shCnr.range("A1") = "J'ecris dans la cellule A1 de la feuille CNRT"

[laurasoe]

Merci de votre réponse
En modifiant ça donne ça je pense:

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
Sub Transpose()
' transpose Macro
 
 
Dim RefChoix As String
Dim adCell As Range
Dim lig As Integer
dim shCnr as worksheet
set shCnr = ThisWorkBook.Sheets("CNRT MOD")
 
dim shMA as worksheet
set shMA = ThisWorkBook.Sheets("MACRO")
 
 
RefChoix = UserForm1.FTre
 
shMA.Range("A2:C" & Sheets("MACRO").Range("A" & Rows.Count).End(xlUp).Row).Copy
 
'cherche la ligne ou ya la référence
Set adCell = shCnr.Cells.Find(RefChoix)
 
If Not adCell Is Nothing Then
    'selectionner ligne+1
    lig = adCell.Row + 1
    'Transpose
    shCnr.Cells(lig, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
    Unload UserForm1
Else
    MsgBox "La référence " & RefChoix & " n'est pas présente dans la feuille CRNT MOD." _
    & vbCrLf & "Traitement annulé.", vbCritical, "Erreur"
    Unload UserForm1
    End
End If
 
shMA.Range("A:C").clear
Application.ScreenUpdating = True
 
End Sub

Mais c'est pas une histoire feuille, je dirai que c'est plus une histoire de cellule.

C'est juste que le copier coller ne se fait pas au bon endroit. La boucle en faite, je viens de me rendre compte, ne cherche pas la référence de la listbox dans la feuille CRNET MOD.

[SfJ5Rpw8]

vérifie déjà si tu recherche bien la bonne chose en affichant ta variable RefChoix

[Marc-L]

Bonjour, bonjour !

Je comprends vite mais ll faut m'expliquer longtemps, et bien !
Et quand ce n'est pas clair, je n'interviens donc pas !

Dès le titre de cette discussion ainsi que dans la présentation initiale :

En faite la chose que je ne comprend c'est que la macro s'exécute et tout mais ne colle pas les éléments au bon endroit ....

Si j'avais été le premier à répondre, cela aurait donné ceci :

« La macro ne se trompe jamais, elle exécute juste ce pour quoi elle est programmée ! »


Après une bonne quarantaine de messages, c'est encore moins clair !

Laura, postez le code complet - et n'y touchez plus ! - et bien expliquer où vous en êtes et ce que vous attendez …

[laurasoe]

Bonjour marc-L

J'avoue qu'en relisant le premier message, c'est pas super attrayant ! désolé

Donc voici le code:

du userform:

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
Option Explicit
Private ws As Worksheet
Public FTre As String
 
Private Sub CommandButton3_Click()
    Dim x As Long, Idx As Long
    Dim FTre()
    Dim Derlig As Range
    ReDim FTre(Idx)
 
    'Création d'un tableau d'éléments sélectionnés
    For x = 0 To ListBox2.ListCount - 1
        ReDim Preserve FTre(Idx)
        FTre(Idx) = ListBox2.List(x, 0)
        Idx = Idx + 1
    Next x
 
 Set Derlig = Range("A" & Rows.Count).End(xlUp)
 
    'Appel de la procédure en lui passant le tableau en paramètre
Range("A1", Derlig).AutoFilter Field:=1, Criteria1:=FTre, Operator:=xlFilterValues
 
  UserForm1.Hide
 
 
End Sub
 
 
Private Sub UserForm_Initialize()
 
Set ws = ThisWorkbook.Worksheets("CRNET-CDE")
    ws.Range("A:AN").AutoFilter Field:=1
 
    Dim Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim I As Integer
 
    'Récupère la derniere ligne non vide dans la colonne A
    I = Range("A65536").End(xlUp).Row
 
    On Error Resume Next
    'boucle sur les cellules de la colonne A
    For Each Cell In Range("A1:A" & I)
        'Stocke les données dans une collection
        '(La collection n'accepte que des données uniques et permet donc
        ' de filtrer facilement les doublons).
        Unique.Add Cell, CStr(Cell)
    Next Cell
    On Error GoTo 0
 
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        Me.ListBox1.AddItem Valeur
    Next Valeur
 
OptionButton3.Value = True
 
End Sub
 
Private Sub CommandButton1_Click()
'ajouter de box 1à 2
Dim I As Integer
 
For I = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(I) = True Then ListBox2.AddItem ListBox1.List(I)
Next I
 
End Sub
 
Private Sub CommandButton2_Click()
'supprimer de box 2 les items
 
Dim I As Long
 
Dim counter As Integer
counter = 0
 
For I = 0 To ListBox2.ListCount - 1
    If ListBox2.Selected(I - counter) Then
        ListBox2.RemoveItem (I - counter)
        counter = counter + 1
    End If
Next I
 
End Sub
 
Private Sub OptionButton1_Click()
'option choix unique
 
ListBox1.MultiSelect = 0
ListBox2.MultiSelect = 0
 
End Sub
 
Private Sub OptionButton2_Click()
'Option les deux avec barre espace
ListBox1.MultiSelect = 1
ListBox2.MultiSelect = 1
 
End Sub
 
Private Sub OptionButton3_Click()
'option multichoix avec touche controle
ListBox1.MultiSelect = 2
ListBox2.MultiSelect = 2
 
End Sub
 
 
Private Sub CheckBox1_Click()
'articles dans la check sans répétitions
If CheckBox1.Value = True Then
    For I = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(I) = True
    Next I
End If
 
If CheckBox1.Value = False Then
    For I = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(I) = False
    Next I
End If
 
End Sub

et de la macro transpose:

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
Public FTre() As String
 
Sub Transpose()
' transpose Macro
 
    Dim I As Long, Derlg As Long
    Dim adCell As Range
    Dim lig As Integer
    Dim shCnr As Worksheet
    Dim shMA As Worksheet
    Dim Derlig As Long
 
    Set shCnr = ThisWorkbook.Sheets("CNRT MOD")
    Set shMA = ThisWorkbook.Sheets("MACRO")
 
 Derlig = shMA.Range("A" & Rows.Count).End(xlUp).Row
 
 
    Range("A2:C" & Derlig).SpecialCells(xlCellTypeVisible).Copy
 
 For I = 0 To UBound(FTre)
        'cherche la ligne ou ya la référence
        Set adCell = shCnr.Cells.Find(FTre(I))
 
        If Not adCell Is Nothing Then
            'selectionner ligne+1
            lig = adCell.Row + 1
            'Transpose
            shCnr.Cells(lig, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
        Else
            MsgBox "La référence " & FTre & " n'est pas présente dans la feuille CRNT MOD." _
                & vbCrLf & "Traitement annulé.", vbCritical, "Erreur"
        End If
    Next
 
 shMA.Range("A:C").Clear
 
 
End Sub

Je voudrai juste rechercher une ligne dans une feuille (CRNET MOD) en fonction de ce qui est dans ma deuxième listbox du userform (et qui ma servi de filtre sur la feuille CRNET CDE). On a nommer ce qu'il y a dans la listbox2 FTre

et ensuite on colle des choses en dessous.


Donc avec l'aide de parmi (merci encore), on a essayer de résoudre le problème et je pense qu'on a pas mal avancé. Le problème est que, quand maintenant j'exécute la macro transpose, un message s'affiche au départ sur la ligne sub transpose () et ils marquent erreur incompatibilité de type.

Donc j'aimerai juste un peu d'aide, pour m'expliquer comment enlever l'erreur d'incompatibilité, et que le tout fonctionne.

Voilà j'espère avoir été plus claire

merci

[Nico Chg]

Bonjour,

Comme FTre est déclaré Public dans un module, il ne faut pas en déclarer (Dim) un autre pour tes filtres.
Comme ça toutes les procédures utiliseront le même FTre.

Tu as toujours un

Code :

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

Dim FTre()

Dans le début de ta procédure CommandButton3_Click(), tu devrais l'enlever

Tu as un soucis d'incompatibilité sur la ligne de déclaration d'un Sub ? Il s'agit réellement de cette ligne, ou tu peux continuer en mode pas à pas ?

Code :

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

Dim I As Long, Derlg As Long

tu n'utilise pas la variable Derlg, pourquoi ne pas la supprimer ?

Ensuite, tu déclare Lig comme un integer, adCell comme un Range, et tu met une égalité entre les deux. Peut être que ton problème vient de la ?
(Edit) Au temps pour moi, je n'avais pas vu que c'étais un Range.row