Discussion :

[lenul78570]

Bonjour,

La macro ci-dessous fonctionne presque bien !
Exemple si dans le classeur "wrso", mois de "janvier" j'ai en BZ62, BZ64 et BZ65 le prénom "Michel".
Je lance la macro, je saisie donc "Michel", puis "janvier", je recherche le classeur "wrsd".

En utilisant le pas à pas (F8) je vois :

A62:BZ62 de "wrso" est bien copiée sur A48:BZ48 de "wrsd"
A64:BZ64 de "wrso" est bien copiée sur A49:BZ49 de "wrsd"

Mais la plage A65:BZ65 vient écraser l'enregistrement déja présent sur A49:BZ49.
Quelqu'un voit il le probleme?
Merci
Lenul78570

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
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
 
'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
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, "\")
'Affiche le chemin et le nom du fichier sélectionné.
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 ' pour chaque cellule avec la valeur choisie
    ' on rechherche la première cellule libre en colonne A
        dl1 = wrsd.Range("a47").End(xlDown).Row + 1
        If dl1 = 65537 Then
        dl1 = 48
        End If
        'on recopie la ligne
        wrsd.Range("a" & dl1 & ":bz" & dl1).Value = wrso.Range("a" & cel.Row & ":bz" & cel.Row).Value
 
    End If
Next cel
wrbd.Save
wrbd.Close
 
 
End Sub

[Krovax]

Bonjour une question,
Pour quoi tu n'utilise pas ceci

Code :

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

DerniereLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row

pour trouver la dernière ligne? cela serait plus simple non?
essaye de remplacer

dl1 = wrsd.Range("a47").End(xlDown).Row + 1
If dl1 = 65537 Then
dl1 = 48
End If

par

Code :

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

dl1=wrsd.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row+1

Après la question est ce que la cellule en colonne A est bien renseigné car ta formule cherche la dernièreligne de la colonne A.

Regarde peut être els formule avec curentregion de cette liste
http://www.developpez.net/forums/d45...gnees-feuille/

exemple

Code :

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

dl1 = Range("A47").CurrentRegion.End(xlDown).Row+1

avec dans ce cas peut être ton test en if pour le 48 si on a 65535, mais met

Code :

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

If dl1 =Columns(1).Cells.Count then

pour être compatible avec 2007

[lenul78570]

Merci de ton aide c'est en effet plus simple et en plus ça fonctionne !
Encore merci et bonne journée
Lenul78570