Mise au point d'une macro

Le
lenul78570
Bonjour,

Voici la macro :

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("BZ62:BZ" & wrso.Cells(wrso.Rows.Count, 25).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 & ":bz" & cel.Row).Copy _
Destination:=wrsd.Range("a" & dl1 & ":bz" & dl1)

End If
Next cel

wrbd.Save
wrbd.Close

End Sub

Présentation du sujet :

Le classeur "devis général" a la macro dans le module 1. Les cellules des lignes 1 à 61 colonnes A à BZ sont vérrouillées et non modifiables.

Le classeur "mes devis". Les lignes 1 à 47 colonnes A à BZ sont verrouillées et non modifiables.

Sur ces 2 classeurs les cellules A et BZ sont des cellules fusionnées A=A:E et BZ=BZ:CE.

Sur chaque lignes il existe aussi d'autres cellules fusionnées entre les colonnes A et BZ.

La zone de destination possède des formats de cellules indentiques à la zone source .

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)

Lorsque j'execute la macro ci-dessus aucune copie ne se fait et aucun message d'erreur n'est renvoyé

Je tourne en rond depuis 3 jours..!
Merci de votre aide
Lenul78570
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Publicité
Poster une réponse
Anonyme