Discussion :

[lenul78570]

Bonjour,

Je sais que vous n'aimez pas trop les fichiers joints, je vous garantie que ces deux là sont sans virus. Mais compte-tenu de ces 2 classeurs je me voyais mal vous présenter le sujet avec du texte !
Présentation du sujet :
1 classeur "devis général" avec un bouton de commande (en A10) pour lancer la macro
1 classeur "mes devis"
Ce que la macro doit éxécuter:
Après la saisie du "prénom", du mois et de l'ouverture du classeur "mes devis" la macro doit sélectionner dans "devis général" à partir de la ligne 62 toutes les lignes (colonnes A à BZ) qui correspondent au "prénom", et copier cette sélection dans "mes devis" à partir de la ligne 48 (colonnes A à BZ)

Exemple :
Si le prénom est Emmanuel, sélection des lignes 62 et 64 (de A à BZ) dans classeur "devis général"
Copie de ces 2 lignes dans le classeur "mes devis" à partir de la ligne 48 (colonnes A à BZ)

J'ai essayé de changer dans la macro

Code :

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

Dim dl1 As Long

dl1 par bz62

Code :

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

Set plage = wrso.Range("D1:D" & wrso.Cells(wrso.Rows.Count, 4).End(xlUp).Row)

"D1-D" par "BZ62:BZ"
4 par 25

Code :

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

1
2
wrso.Range("a" & cel.Row & ":d" & cel.Row).Copy _
            Destination:=wrsd.Range("a" & dl1 & ":d" & dl1)

":d" par ":bz"

Mais impossible de trouver la bonne solution... Je suis NUL.....
Si quelqu'un peut m'aider merci d'avance
Lenul78570

[jp014]

Bonjour

Bonjour,

1 classeur "devis général" avec un bouton de commande (en A10) pour lancer la macro
1 classeur "mes devis"
Ce que la macro doit éxécuter:
Après la saisie du "prénom", du mois et de l'ouverture du classeur "mes devis" la macro doit sélectionner dans "devis général" à partir de la ligne 62 toutes les lignes (colonnes A à BZ) qui correspondent au "prénom", et copier cette sélection dans "mes devis" à partir de la ligne 48 (colonnes A à BZ)

Code :

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

Set plage = wrso.Range("D1:D" & wrso.Cells(wrso.Rows.Count, 4).End(xlUp).Row)

Code :

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

1
2
wrso.Range("a" & cel.Row & ":d" & cel.Row).Copy _
            Destination:=wrsd.Range("a" & dl1 & ":d" & dl1)

Lenul78570

devis général correspond au workbook origine : wrso
mes devis correspond au workbook destination : wrsd

Code :

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

Set plage = wrso.Range("D1:D" & wrso.Cells(wrso.Rows.Count, 4).End(xlUp).Row)

Correspond à la plage de recherche du nom qui commence à " partir de la ligne 62" en colonne D
Il faut donc écrire

Code :

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

Set plage = wrso.Range("D62:D" & wrso.Cells(wrso.Rows.Count, 4).End(xlUp).Row)

Le code suivant réalise la copie des données

Code :

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

1
2
wrso.Range("a" & cel.Row & ":d" & cel.Row).Copy _
            Destination:=wrsd.Range("a" & dl1 & ":d" & dl1)

Or la copie doit copier les "colonnes A à BZ"

Code :

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

1
2
wrso.Range("A" & cel.Row & ":BZ" & cel.Row).Copy _
            Destination:=wrsd.Range("A" & dl1 & ":BZ" & dl1)

Il manque la ligne ou l'on doit mettre la copie, ligne qui commence à 48
le code suivant permet de trouver la première ligne vide

Code :

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

1
2
dl1 = wrsd.Cells(wrsd.Rows.Count, 1).End(xlUp).Row + 1
If dl1 < 48 then dl1 = 48

Si le numéro de ligne est inférieur à 48, dl1 prend la valeur 48.

JP

[lenul78570]

Merci JP014

Mais je me suis rendu compte que mes pieces jointes sont absentes et quand j'ai voulu refaire le message on me dit qu"elles sont trop importante donc j'ai recré une nouvelle discussion avec plus de précision sur la composition de mes classeurs
Lenul78570

[lenul78570]

Bonjour,

Présentation du sujet :

1 classeur "devis général" avec un bouton de commande pour lancer la macro. Les cellules des lignes 1 à 61 colonnes A à BZ sont vérrouillées et non modifiables
1 classeur "mes devis". Les lignes 1 à 47 colonnes A à BZ sont verrouillées et non modifiables.
Sur ces 2 classeurs les cellules A62 et BZ62 et A48 et BZ48 sont des cellules fusionnées A=A:E et BZ=BZ:CE.
Sur chaque lignes il existe aussi d'autre cellules fusionnées entre les colonnes A et BZ.
Ces deux classeurs ont des lignes identiques pour les cellules fusionnées.

Ce que la macro doit éxécuter:
Après la saisie du "prénom", du mois et de l'ouverture du classeur "mes devis" la macro doit sélectionner dans "devis général" à partir de la ligne 62 toutes les lignes (colonnes A à BZ) qui correspondent au "prénom", et copier cette sélection dans "mes devis" à partir de la ligne 48 (colonnes A à BZ).

Exemple :
Si le prénom est Emmanuel, sélection des lignes 62 et 64 (de A à BZ) dans classeur "devis général"
Copie de ces 2 lignes dans le classeur "mes devis" à partir de la ligne 48 (colonnes A à BZ)

Voici la macro :

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
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
 
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("D1:D" & wrso.Cells(wrso.Rows.Count, 4).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.Cells(wrsd.Rows.Count, 1).End(xlUp).Row + 1
        'on recopie la ligne
        wrso.Range("a" & cel.Row & ":d" & cel.Row).Copy _
            Destination:=wrsd.Range("a" & dl1 & ":d" & dl1)
 
    End If
Next cel
 
wrbd.Save
wrbd.Close
 
End Sub

J'ai essayé de changer dans la macro

Code :
Dim dl1 As Long
dl1 par bz62

Code :
Set plage = wrso.Range("D1:D" & wrso.Cells(wrso.Rows.Count, 4).End(xlUp).Row)
"D1:D" par "BZ62:BZ"
4 par 25

Code :
wrso.Range("a" & cel.Row & ":d" & cel.Row).Copy _
Destination:=wrsd.Range("a" & dl1 & ":d" & dl1)
":d" par ":bz"

Mais impossible de trouver la bonne solution... Je suis NUL.....
Si quelqu'un peut m'aider merci d'avance
Lenul78570