Erreur incompréhensible dans ma Macro (VBA) à l'aide!

Version imprimable

Bonjour à tous,

Dans le cadre de mon stage, je dois "pimper" un fichier excel avec tout un tas de macro. Là j'en ai fait une pour sélectionner des lignes qui correspondent à un ou deux critères. Le problème que je ne comprends pas se situe à la ligne ou je sélectionne les données. Le programme bloque dessus et me met une erreur de variable incompatible!:calim2::calim2::calim2:

J'ai fait une macro plus simple qui fait presque la même chose (mais tous les critères doivent être renseignés) et la sélection fonctionne quand une seule ligne correspond mais quand il y en a plusieurs cela bloque...:lol:

J'ai besoin donc de l'aide d'un gentils exceliste pour me sortir de ce pétrin!

Merci d'avance :P

Code:

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
 
Sub Recherche_Critères()
Dim i As Integer, j As Byte, DerLig As Integer
Dim Contrôle_Dossier As Boolean, Contrôle_Langue As Boolean, Contrôle_Société As Boolean
Dim Drapeau As Boolean
Dim MesLignes
 
    DerLig = Sheets("RCEL").Range("A" & Rows.Count).End(xlUp).Row
 
 
    For i = 20 To DerLig ' Lignes de la feuille 'RCEL'
 
        'Dossier N° ------------ Début
        If Sheets("Filtre").Range("A25") = "" Then
            Contrôle_Dossier = True
            GoTo Etiquette_Langue
        End If
 
       'Colonnes A
            If Sheets("Filtre").Range("A25") = Sheets("RCEL").Cells(i, 1) Then
                Contrôle_Dossier = True
                GoTo Etiquette_Langue
            End If
 
        'LOCALITES ------------ Fin
 
 
 
        'Langue ------------ Début
Etiquette_Langue:
 
        If Sheets("Filtre").Range("B25") = "" Then
            Contrôle_Langue = True
        End If
 
        'Colonnes B
            If Sheets("Filtre").Range("B25") = Sheets("RCEL").Cells(i, 2) Then
                Contrôle_Langue = True
            End If
 
        'Langue ------------ Fin
 
        'FACADE ------------ Début
'Etiquette_FACADE:
        'If .Cells(i, 7) >= Range("R" & ActiveCell.Row) Then Contrôle_Façade = True
        'FACADE ------------ Fin
 
 
 
        'DIMENSION ------------ Début
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Etiquette_DIMENSION:
        'DIMENSION ------------ Fin
 
        'Résultat
        If Contrôle_Dossier = True And Contrôle_Langue = True Then
            'MsgBox ("Le dossier " & Sheets("RCEL").Cells(i, 1) & " conviendrait à ce(s) critères")
            MesLignes = MesLignes & i & ":" & i & "," 'Stockage des lignes qui répondent au critère
            Drapeau = True
        End If
 
 
 
 
        Contrôle_Dossier = False
        Contrôle_Langue = False
        'Contrôle_Façade = False
 
    Next i
 
 
 
If Drapeau = False Then MsgBox "Aucun dossier correspondant aux critères (vérifier les critères)"
If MesLignes <> "" Then
Worksheets("RCEL").Activate
MesLignes = Left(MesLignes, Len(MesLignes) - 1)
MsgBox ("Mes lignes " & MesLignes)
MesLignes = CStr(MesLignes)
Sheets("RCEL").Rows(MesLignes).Select
End If
 
End Sub

Ci-dessus c'est la macro qui ne fonctionne pas...du moins dès qu'il y a plusieurs entités qui correspondent aux critères. Je pense donc que l'écriture de la variable MesLignes comporte une erreur!
Cependant quand je l'affiche dans la messagebox, elle semble correcte:

Citation:

12:12,15:15,67:67

Voilà merci de votre aide je suis toute désespérée:(

Bonjour,test ça

Code:

1
2
3
4
5
6
7
8
9
If Contrôle_Dossier = True And Contrôle_Langue = True Then
            'MsgBox ("Le dossier " & Sheets("RCEL").Cells(i, 1) & " conviendrait à ce(s) critères")
            If Trim("" & MesLignes) = "" Then
                MesLignes = i & ":" & i    'Stockage des lignes qui répondent au critère
            Else
            MesLignes = MesLignes & "," & i & ":" & i  'Stockage des lignes qui répondent au critère
            End If
            Drapeau = True
        End If

Code:

1
2
3
4
5
6
7
If Trim("" & MesLignes) <> "" Then
    Worksheets("RCEL").Activate
    'MesLignes = Left(MesLignes, Len(MesLignes) - 1)
    MsgBox ("Mes lignes " & MesLignes)
    'MesLignes = CStr(MesLignes)
    Sheets("RCEL").Range(MesLignes).Select
End If

02/09/2014, 15h37
Wendy_26

Bonjour rdurupt!

Merci de ta contribution! Alors cela fonctionne si j'ai un nombre limite de données mais si je le fais sur toutes mes données il y aurait apparemment trop de lignes à sélectionner!

Il y a un nombre limite de lignes pour la sélection multi-ligne? L'erreur vient apparemment de là!

Du coup il faudrait qu'à chaque fois que le code trouve une correspondance, qu'il copie cette ligne sur une nouvelle feuille puis ajoute les autres correspondances en-dessous! C'est possible ça?
02/09/2014, 16h40
Invité

test ça

Code:

Sheets("RCEL").Rows(MesLignes).copy Sheets("FEUILLE").range("A1")
02/09/2014, 18h57
piotr76

Bonjour
Vite fait en passant. Il ne manquerait pas un "Destination" pour le "copy"

Code:

Sheets("RCEL").Rows(MesLignes).copy Destination:=Sheets("FEUILLE").range("A1")

Cordialement
02/09/2014, 19h56
SfJ5Rpw8

bonsoir,

cela n'as peu être rien à voir mais pourquoi déclarer votre variable en variant

Code:

Dim MesLignes

alors que le type désiré est connu : chaine :

Code:

Dim MesLignes as string
02/09/2014, 21h25
Igloobel

Bonsoir,

J'ai pas regarder à fond mais il me semble bien que lorsque l'on construit une plage les séparateurs sont les ":" et ";" et non pas ","

vu que notre amie nous dit

Citation:

...et la sélection fonctionne quand une seule ligne correspond mais quand il y en a plusieurs cela bloque...

A+
02/09/2014, 21h48
parmi

Le problème vient du fait qu'elle utilise Rows plutôt que Range.
Et comme c'est en VBA, les séparateurs ":" et "," sont corrects... anglais oblige... ;)
03/09/2014, 00h01
Invité

Non c'est obligé mais si tu veux!

Citation:

Envoyé par piotr76

Bonjour
Vite fait en passant. Il ne manquerait pas un "Destination" pour le "copy"

Code:

Sheets("RCEL").Rows(MesLignes).copy Destination:=Sheets("FEUILLE").range("A1")

Cordialement
03/09/2014, 07h25
Wendy_26

Citation:

Envoyé par rdurupt

Code:

Sheets("RCEL").Rows(MesLignes).copy Sheets("FEUILLE").range("A1")

Merci rdurupt! Ce code marche du tonnerre à nouveau! Toutefois quand il y a beaucoup de lignes, cela ne marche plus. Pour une ou trois il y a aucun soucis! Du coup je vais devoir intégrer cela directement dans la boucle et faire la copie au fur et à mesure qu'il trouve des correspondances! :D

Citation:

Envoyé par bbil

bonsoir,

cela n'as peu être rien à voir mais pourquoi déclarer votre variable en variant

Code:

Dim MesLignes

alors que le type désiré est connu : chaine :

Code:

Dim MesLignes as string

Hello bbil! Tout simplement car je n'étais pas sûre que c'était du string. Mais les deux fonctionnent en tout cas ;)

Merci à Igloobel, Piotr76 et parmi d'avoir donné une réponse ou une explication!

Je vais de ce pas m'attaquer à la copie dynamique et je reviens vous voir pour donner le résultat qui marche je l'espère :mrgreen:

bye bye

Hello messieurs!

Alors voilà le code final qui fonctionne parfaitement!

J'ai conservé la variable MesLignes en guise de contrôle comme j'ai 120 autres critères à ajouter, il va falloir faire des tests pour tout vérifier. J'ai donc créer un incrément k et une variable CopyLigne qui copie et colle la ligne à copier dans la feuille "Selection"! J'ai aussi rajouter 3 lignes en début de code qui vident les enregistrements copiés dans "Selection" lors de la recherche précédente!

En tout cas un gros merci à tous et bonne continuation :rose2:

Code:

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
Sub Recherche_Critères()
Dim i As Integer, j As Byte, DerLig As Integer
Dim Contrôle_Dossier As Boolean, Contrôle_Langue As Boolean, Contrôle_Société As Boolean
Dim Drapeau As Boolean
Dim MesLignes As String
Dim k As Integer 'compteur des lignes à copier
Dim LignesCopy As String 'numéro de la ligne à copier
 
' SUPPRESSION DES DONNES SELECTIONNEES LORS D'UNE UTILISATION PRECEDENTES
    Sheets("Selection").Select
    Rows("20:20").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
' -----------------------------------------------------------------------
 
    DerLig = Sheets("RCEL").Range("A" & Rows.Count).End(xlUp).Row
 
    k = 20 'initialisation du compteur au numéro de la première ligne (i.e. 20)
    For i = 20 To DerLig ' Lignes de la feuille 'RCEL'
 
        'Dossier N° ------------ Début
        If Sheets("Filtre").Range("A25") = "" Then
            Contrôle_Dossier = True
            GoTo Etiquette_Langue
        End If
 
       'Colonnes A
            If Sheets("Filtre").Range("A25") = Sheets("RCEL").Cells(i, 1) Then
                Contrôle_Dossier = True
                GoTo Etiquette_Langue
            End If
 
        'LOCALITES ------------ Fin
 
 
 
        'Langue ------------ Début
Etiquette_Langue:
 
        If Sheets("Filtre").Range("B25") = "" Then
            Contrôle_Langue = True
        End If
 
        'Colonnes B
            If Sheets("Filtre").Range("B25") = Sheets("RCEL").Cells(i, 2) Then
                Contrôle_Langue = True
            End If
 
        'Langue ------------ Fin
 
        'FACADE ------------ Début
'Etiquette_FACADE:
        'If .Cells(i, 7) >= Range("R" & ActiveCell.Row) Then Contrôle_Façade = True
        'FACADE ------------ Fin
 
 
 
        'DIMENSION ------------ Début
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Etiquette_DIMENSION:
        'DIMENSION ------------ Fin
 
        'Résultat
       If Contrôle_Dossier = True And Contrôle_Langue = True Then
 
            If Trim("" & MesLignes) = "" Then
                MesLignes = i & ":" & i    'Stockage des lignes qui répondent au critère
            Else
            MesLignes = MesLignes & "," & i & ":" & i  'Stockage des lignes qui répondent au critère
            End If
            LignesCopy = i & ":" & i
            Sheets("RCEL").Range(LignesCopy).copy Sheets("Selection").Range("A" & k)
            k = k + 1
            Drapeau = True
        End If
 
 
 
        Contrôle_Dossier = False
        Contrôle_Langue = False
        'Contrôle_Façade = False
 
    Next i
 
 
 
If Drapeau = False Then MsgBox "Aucun dossier correspondant aux critères (vérifier les critères)"
 
If Trim("" & MesLignes) <> "" Then
    Worksheets("Selection").Activate
    MsgBox ("Mes lignes " & MesLignes)
End If
 
End Sub

03/09/2014, 11h43
parmi

Lorsque tu déclares des variables concernant le nombre de lignes ou servant à boucler le nombre de lignes, utilise le Long plutôt que Integer.
Un Integer va te donner une erreur un jour ou l'autre...

Et, de toutes façons, avec les machines que nous avons maintenant, ce n'est plus vraiment important de réduire au minimum l'espace mémoire alloué par les variables...

Bonne continuation à toi aussi.

Citation:

Envoyé par Wendy_26

Hello messieurs!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
        'Résultat
       If Contrôle_Dossier = True And Contrôle_Langue = True Then
 
            If Trim("" & MesLignes) = "" Then
                MesLignes = i & ":" & i    'Stockage des lignes qui répondent au critère
            Else
            MesLignes = MesLignes & "," & i & ":" & i  'Stockage des lignes qui répondent au critère
            End If
            LignesCopy = i & ":" & i
            Sheets("RCEL").Range(LignesCopy).copy Sheets("Selection").Range("A" & k)
            k = k + 1
            Drapeau = True
        End If

simplifies ton code le reste n'est pas utile!

Code:

1
2
 If Contrôle_Dossier = True And Contrôle_Langue = True Then
    Sheets("RCEL").Range( i & ":" & i ).copy Sheets("Selection").Range("A" & k)

Citation:

Envoyé par Wendy_26

Hello messieurs!

Code:

1
2
3
4
Sheets("Selection").Select
    Rows("20:20").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

Code:

1
2
3
 
Set r =Sheets("Selection").Rows("20:20")
 Range(r, r.End(xlDown)).ClearContents

04/09/2014, 08h09
Wendy_26

Merci pour ces petites améliorations!
J'ai aussi changer les déclarations de variables en Long!

Hello les copains!

Je reviens à la charge avec une autre problématique!
Dans le même fichier, au début j'importe des données issues d'un autre classeur. Or dans ces données il y a des listes déroulantes de choix (Monsieur, Madame, Autre) par exemple. Est-il possible de coller les cellules en enlevant ces listes de choix? J'ai le code suivant :
Code:

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 Sub copy() ' Variable pour le classeur où sera copié la base de donnée Set NwWBK = ThisWorkbook ' Ouverture par l'utilisateur du classeur à copier Dim Fichier As Variant Fichier = Application.GetOpenFilename(Title:="Choix du fichier de comparaison") If Fichier <> False Then Set Fich = Workbooks.Open(Fichier) End If Set OldWBK = ActiveWorkbook 'Copie de la feuille RCEL If NwWBK.Worksheets("RCEL").AutoFilterMode Then NwWBK.Worksheets("RCEL").AutoFilterMode = False End If OldWBK.Worksheets("RCEL").Cells.copy _ NwWBK.Worksheets("RCEL").Range("A1") '.PasteSpecial Paste:=xlPasteValues ' Copie-colle le fichier OldWBK.Close False 'Referme le fichier source 'NwWBK.Worksheets("RCEL").Range("A1:FS1000").Value = NwWBK.Worksheets("RCEL").Range("A1:FS1000").Value ' Figer la ligne supérieur de la feuille RCEL With Worksheets("RCEL").Activate ActiveWindow.SplitColumn = 0 ActiveWindow.SplitRow = 1 End With ActiveWindow.FreezePanes = True End Sub
J'ai essayé de copier en tant que valeur avec pastespecial mais il y a une erreur insoluble apparemment liée à ces listes...
La copie avec "=" afin de faire une copie en tant que valeur n'enlèvent pas les listes non plus. :(

04/09/2014, 11h35
Invité
Citation:

Envoyé par Wendy_26

Hello les copains!

J'ai essayé de copier en tant que valeur avec pastespecial mais il y a une erreur insoluble apparemment liée à ces listes...
La copie avec "=" afin de faire une copie en tant que valeur n'enlèvent pas les listes non plus. :(

bonjour,
test ce code
Code:

1 2 Set r = OldWBK.Worksheets("RCEL").UsedRange NwWBK.Worksheets("RCEL").Range(r.Address).Value = r.Cells.Value
04/09/2014, 11h40
Wendy_26

Hello,

Merci c'est parfait comme ça! :D