If-End if :sans effet....

Version imprimable

Bonjour au Forum

La macro ci-dessous, lancée par un bouton est censée pour un prénom donné et pour un mois choisi de copier toutes les lignes (colonne A à CE) du classeur « général » sur le classeur « perso ».
Problème : cette macro ne « bug » pas, mais elle ne copie rien !
En faisant le contrôle en pas à pas, j'ai découvert que les lignes suivantes étaient "ignorées":

Code:

1
2
3
dl1 = wrsd.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row + 1
 
        wrsd.Range("a" & dl1 & ":bz" & dl1).Value = wrso.Range("a" & cel.Row & ":bz" & cel.Row).Value

Le pas à pas passe directement de :
If cel = prenom Then
à : End If

Je ne comprends pas pourquoi ......
Lenul

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
Sub copie()
'
' copie Macro
'
 
Dim prenom As String, mois As String
Dim plage As Range, cel As Range
Dim trouve As Byte
Dim reponse As Variant, Fichier As Variant
Dim Sh As Worksheet
Dim wrbo As Workbook, wrbd As Workbook
Dim wrso As Worksheet, wrsd As Worksheet
Dim chemin As String, nomfichier As String
Dim tablo() As String
Dim dl1 As Long
 
Do
        reponse = Application.InputBox(Title:="Copie de mes devis", Prompt:="Indiquez votre prénom :", Type:=2, Default:="")
        Select Case reponse
            Case ""
                MsgBox "vous n'avez pas  fait de saisies!" & Chr(13) & "recommencez!", vbCritical, "GRRrrrr!"
            Case False
                Exit Sub
            Case Else
                Exit Do
        End Select
 Loop
prenom = reponse
Do
        reponse = Application.InputBox(Title:="Copie de mes devis", Prompt:="Indiquez pour quel mois vous voulez copier vos devis :", Type:=2, Default:="")
        Select Case reponse
            Case ""
                MsgBox "vous n'avez pas  fait de saisies!" & Chr(13) & "recommencez!", vbCritical, ""
            Case False
                Exit Sub
            Case Else
 
                    For Each Sh In Worksheets
                        If Sh.Name = reponse Then trouve = 1
                    Next Sh
                If trouve = 1 Then Exit Do
                MsgBox ("Le mois demandé n'exste pas dans le classeur")
        End Select
 Loop
mois = reponse
 
Application.ScreenUpdating = False
 
Set wrbo = ThisWorkbook
Set wrso = wrbo.Sheets(mois)
 
 
Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
If Fichier = False Then Exit Sub
Workbooks.Open Filename:=Fichier
tablo = Split(Fichier, "\")
Set wrbd = Workbooks(tablo(UBound(tablo)))
Set wrsd = wrbd.Sheets(mois)
 
Set plage = wrso.Range("BZ62:BZ" & wrso.Cells(wrso.Rows.Count, 78).End(xlUp).Row)
For Each cel In plage
    If cel = prenom Then
 
        dl1 = wrsd.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row + 1
 
        wrsd.Range("a" & dl1 & ":bz" & dl1).Value = wrso.Range("a" & cel.Row & ":bz" & cel.Row).Value
 
    End If
Next cel
wrbd.Save
wrbd.Close
wrbo.Save
wrbo.Close
 
End Sub

21/05/2010, 11h20
Gorfael

Salut lenul78570 et le forum

Citation:

Le pas à pas passe directement de :
If cel = prenom Then
à : End If

Après une intense réflexion, je pense pouvoir t'affirmer que cel est différent de prénom :mrgreen:.
"aa" est différent de :
" aa", "aa ", "AA", "Aa", "aA" ou "àa".
Regarde les valeurs de cel et de prenom.
Pas moyen de t'aider sur une incohérence comme ça : ce n'est pas le code qui est directement en cause, mais les données, et nous, on ne peut rien y faire.
tu peux remplacer "If cel = prenom Then" par "If ucase(cel) = ucase(prenom) Then", modifier option compare, ce que je n'aime pas trop, ou utiliser l'opérateur Like.
A+
21/05/2010, 11h42
lenul78570

Bonjour Gorfael
Merci de prendre le temps de me réponde.
Mon premier InputBox me demande le "prenom" exemple saisie "Michel", dans la colonne BZ, après vérification il y a 9 cellules qui contiennent "Michel"......

Le remplacement que tu m'as proposé ne change rien .... désolé

Lenul

Salut !

Peux-tu déjà vérifier si tu rentres dans ta condition ?
Code:

1 2 3 4 5 6 7 8 9 10 11 For Each cel In plage MsgBox cel MsgBox prenom If cel = prenom Then dl1 = wrsd.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row + 1 wrsd.Range("a" & dl1 & ":bz" & dl1).Value = wrso.Range("a" & cel.Row & ":bz" & cel.Row).Value End If Next cel
Pour chaque cel, ces 2 MsgBox t'afficheront cel et prenom. Peut-être qu'il y a une erreur dans le code du dessus et que cel n'est jamais égal à prenom et que tu coup tu ne rentres jamais dans ta condition.

A+

EDIT : de plus, ce n'est pas comme ça qu'on copie des Range. Il faut faire :
Code:

1 2 3 wrso.Range("a" & cel.Row & ":bz" & cel.Row).Copy wrsd.Range("a" & dl1 & ":bz" & dl1).Activate ActiveSheet.Paste
Ca devrait fonctionner.

Bonne chance pour la suite.

21/05/2010, 13h26
BenjGe

essaie avec

Code:

cstr(cel.value)=prenom

ou comme tu as l'air d'écrire des codes depuis les bilbothèques

Code:

VBA.Conversion.Cstr(cel.value)=prenom

et pour ne pas tenir compte de la casse:

Code:

ucase(cstr(cel.value))=ucase(prenom)

il est possible que tes cellules contiennent des espaces superflus:

Code:

trim(ucase(cstr(cel.value)))=trim(ucase(prenom))
21/05/2010, 15h31
lenul78570

Bonjour Benjîle
Merci de ta participation.
J'ai essayé les 4 propositions....même résultat !
Merci quand même et bon week end
Lenul
21/05/2010, 15h46
Tempas

Peux-tu poster le fichier pour le tester en direct ? (comme ca on aura les valeurs dans les cellules etc...)
21/05/2010, 19h59
mercatog

Citation:

Code:

wrsd.Range("a" & dl1 & ":bz" & dl1).Value = wrso.Range("a" & cel.Row & ":bz" & cel.Row).Value

à DeaD78
cette écriture est valable.

Code:

Range(A).Value=Range(B).Value

est valable si A et B sont de taille identique. (le .Value est nécessaire si A et B comportent plusieurs cellules)
et c'est même conseillé pour copier des valeurs sans passer par le presse papier

ok retapes ta boucle avec une instruction de débogage:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
 
debug.print  "Plage étudiée :" & plage.address, "Prénom vaut:" & prenom
debug.print chr(10) & "Adresse", "Valeur", "Nbre de caractères", "Résultat du test"
For Each cel In plage
debug.print cel.address, cel.value, len(cel.value), prenom, cel.value=prenom
    If trim(ucase(cstr(cel.value)))=trim(ucase(prenom)) Then
 
        dl1 = wrsd.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row + 1
 
        wrsd.Range("a" & dl1 & ":bz" & dl1).Value = wrso.Range("a" & cel.Row & ":bz" & cel.Row).Value
 
    End If
Next cel

avant de lancer ta macro appuie sur CTRL+G, cela fera apparaître la fenêtre exécution affichant les instructions de débogage

Examine le résultat, il t'en dira plus sur le problème.

23/05/2010, 14h56
AlainTech

Citation:

Envoyé par lenul78570

après vérification il y a 9 cellules qui contiennent "Michel"......

Je parie qu'il n'y a pas que "Michel" dans la cellule...

Vois l'aide sur la fonction Instr.
Je pense que ça pourait t'aider.
25/05/2010, 16h09
lenul78570

Bonjour à Tous

Merci à Tous de votre aide.
J'ai trouvé le probleme, une autre personne que moi est venu "bricoler" dans VBA et avait changé la ligne ci-dessous :

Code:

Set plage = wrso.Range("BZ62:BZ" & wrso.Cells(wrso.Rows.Count, 78).End(xlUp).Row)

par celle-ci :

Code:

Set plage = wrso.Range("BZ62:BZ" & wrso.Cells(wrso.Rows.Count, 83).End(xlUp).Row)

Les prénoms étant en colonne BZ, la 78, aucun prénom n'était trouvé !

Bonne journée à Tous.
Lenul
27/05/2010, 10h49
Gorfael

Salut lenul78570 et le forum
Juste une suggestion :

Code:

Set plage = wrso.Range("BZ62:BZ" & wrso.Cells(wrso.Rows.Count, 78).End(xlUp).Row)

Quand on lit un code, difficile de penser à vérifier que la colonne 78 est bien la bonne. Je n'utilise les nombres pour désigner des colonnes que lorsque c'est aboslument nécessaire, comme dans une boucle (et encore, je me sers souvent de l'Offset).

À mon sens, le code est plus lisible quand on emploie les lettres et évite bien des erreurs.

Code:

Set plage = wrso.Range(wrso.[BZ62], wrso.Cells(wrso.Rows.Count, "BZ").End(xlUp))

A+