macro sur fichier renommé

Bonjour, j'ai soumis se problème le 5 sept dernier j'ai
testé les réponses fournies mais ça ne fonctionne pas. Je
pense que je n'ai pas assez donné d'explications sur le
problème à résoudre et j'en suis désolé. Parfois en
voulant être concis, cela
crée de la confusion.j'aide une amie à convertir des
fichiers lotus123 en excel. Voilà l'exposé de la
situation.

Voici le classement officiel des fichers:
C:revenus2003aoutaaout03.xls ' fichier où est la macro
C:revenus2003aoutdrj0818.xls ' fichier où sont copiés
les données.

La macro est écrite dans le fichier C:revenus2003
aoutaaout03.xls et le fichier est renommé une fois par
mois. C:revenus2003septasept03.xls. C:revenus2003
octaoct03.xls. etc. Elle sert à aller copier des
données dans le fichier drj. Il y a un nouveau fichier drj
qui est créé tous les jours. C:revenus2003
septdrj0901.xls. C:revenus2003septdrj0902.xls. etc.
Donc, à chaque jour, la macro est exécutée pour aller
chercher la nouvelle journée dans le «drj».

Initialement je pensais que le fichier de la macro était
toujours le même donc avec cette ligne: Windows
("revenus.«xls»").Activate
Tout fonctionnait bien. Mais j'ai appris cette semaine que
le fichier hôte de la macro change à tous les mois. Et de
plus sur le réseau où va être utilisé la macro ils ne
peuvent entrer plus de 8 caractères pour nommer les
fichers. Donc les mois doivent
être en date courte. Je pense comme cela mmm . Dans les
premiers jour du mois. Exemple le 1er sept, c'est le
fichiers C:revenus2003
aoutaaout03.xls qui est utilisé. Donc ont ne peut pas
dire que le fichier hôte porte automatiquement l'extension
du mois courant.
Voilà il faut une solution pour que le code gère cette
situation.
Prévoir aussi que lorsque la personne exécute la macro il
peut y avoir d'autres fichiers excel ouverts sur son
ordinateur.

Je vous redonne le code qui fonctionne à merveille sur la
version excel xp et windows xp lorsque le fichier hôte de
la macro n'est
pas renommé.
P.s petit ajustement supplémentaire à apporter. Lorsque
les inputbox me demandent de selectionner une année , un
mois et le jour. Si je réponds annuler à la question de la
boîte la fenêtre de débogage s'ouvre!

Votre aide m'est très précieuse et j'ai déjà appliqué des
brides de ce code dans plusieurs autres situations.

Est-ce que la solution serait de faire des inputbox pour
le fichier hôte!!!
Merci.

Sub upgradeF_B()



an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))
mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour", Day(Now)))
dat = DateSerial(an, mo, da)

chemin = "C:revenue" & Format(dat, "yyyy") & "" &
Format(dat, "mmmm")
chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"

fic = chemin & "" & suf

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _
fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une erreur
awn = ActiveWorkbook.Name
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then MsgBox suf & " est déjà ouvert, " & _
vbNewLine & " " & _
vbNewLine & "s.v.p. veuillez fermer le drj ! ": _
Windows(awn).Activate: Exit Sub

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe pas !": _
Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
Selection.Copy

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Windows("revenus.xls").Activate ' section à améliorer

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:úlse
Windows(suf).Activate
ActiveSheet.Protect
ActiveWorkbook.save

ActiveWorkbook.Close
End Sub

-----Message d'origine-----
Bonsoir,

J'ai essayé de modifier ta macro en fonction de ce que
j'ai compris de ton

problème et de ton code. Les modifications proposées sont
commentées. A tester

(attention aux coupures de lignes provoquées par nos
logiciels de courriel) :

Sub upgradeF_B()

an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))

mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))

da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

'***petite correction : "C:revenus" au lieu
de "C:revenue"

chemin = "C:revenus" & Format(dat, "yyyy") & "" &
Format(dat, "mmmm")

chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"
fic = chemin & "" & suf

'***pourquoi cette demande puisqu'il ne faut pas que ce
fichier soit ouvert ?

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _

fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une erreur
awn = ThisWorkbook.Name '***remplacer ActiveWorkbook
par ThisWorkbook :

'***même renommé, la macro suit le classeur et
Thisworkbook fait toujours

'***référence au classeur qui contient son code
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then
MsgBox suf & " est déjà ouvert, " & vbNewLine & " " &
_

vbNewLine & "s.v.p. veuillez fermer le drj ! "
Exit Sub
End If
On Error GoTo 0 '***(pour être alerté si erreurs par la
suite)

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe pas !":
Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
Windows(awn).Activate '***la source des données (si
j'ai bien compris)

'***doit être active pour que la copie s'applique
aux 'bonnes' données

ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
'***copie dans le classeur source
Selection.Copy

'***active le classeur cible
Windows(suf).Activate
'***collage des données
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, _

Operation:=xlNone, SkipBlanks:=True,
Transpose:úlse

'***enregistre et ferme la cible de la copie (classeur
drj)

Workbooks(suf).Close True
'***réactive, protège, enregistre et quitte le classeur
source

'***(qui contient ce code)
Windows(awn).Activate
ActiveSheet.Protect
ActiveWorkbook.Close True
End Sub

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonjour, j'ai soumis se problème le 5 sept dernier j'ai
testé les réponses fournies mais ça ne fonctionne pas.
Je

pense que je n'ai pas assez donné d'explications sur le
problème à résoudre et j'en suis désolé. Parfois en
voulant être concis, cela
crée de la confusion.j'aide une amie à convertir des
fichiers lotus123 en excel. Voilà l'exposé de la
situation.

Voici le classement officiel des fichers:
C:revenus2003aoutaaout03.xls ' fichier où est la
macro

C:revenus2003aoutdrj0818.xls ' fichier où sont
copiés

les données.

La macro est écrite dans le fichier C:revenus2003
aoutaaout03.xls et le fichier est renommé une fois par
mois. C:revenus2003septasept03.xls. C:revenus2003
octaoct03.xls. etc. Elle sert à aller copier des
données dans le fichier drj. Il y a un nouveau fichier
drj

qui est créé tous les jours. C:revenus2003
septdrj0901.xls. C:revenus2003septdrj0902.xls.
etc.

Donc, à chaque jour, la macro est exécutée pour aller
chercher la nouvelle journée dans le «drj».

Initialement je pensais que le fichier de la macro était
toujours le même donc avec cette ligne: Windows
("revenus.«xls»").Activate
Tout fonctionnait bien. Mais j'ai appris cette semaine
que

le fichier hôte de la macro change à tous les mois. Et
de

plus sur le réseau où va être utilisé la macro ils ne
peuvent entrer plus de 8 caractères pour nommer les
fichers. Donc les mois doivent
être en date courte. Je pense comme cela mmm . Dans les
premiers jour du mois. Exemple le 1er sept, c'est le
fichiers C:revenus2003
aoutaaout03.xls qui est utilisé. Donc ont ne peut pas
dire que le fichier hôte porte automatiquement
l'extension

du mois courant.
Voilà il faut une solution pour que le code gère cette
situation.
Prévoir aussi que lorsque la personne exécute la macro
il

peut y avoir d'autres fichiers excel ouverts sur son
ordinateur.

Je vous redonne le code qui fonctionne à merveille sur
la

version excel xp et windows xp lorsque le fichier hôte
de

la macro n'est
pas renommé.
P.s petit ajustement supplémentaire à apporter. Lorsque
les inputbox me demandent de selectionner une année , un
mois et le jour. Si je réponds annuler à la question de
la

boîte la fenêtre de débogage s'ouvre!

Votre aide m'est très précieuse et j'ai déjà appliqué
des

brides de ce code dans plusieurs autres situations.

Est-ce que la solution serait de faire des inputbox pour
le fichier hôte!!!
Merci.

Sub upgradeF_B()



an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))
mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

chemin = "C:revenue" & Format(dat, "yyyy") & "" &
Format(dat, "mmmm")
chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"

fic = chemin & "" & suf

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _
fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une erreur
awn = ActiveWorkbook.Name
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then MsgBox suf & " est déjà ouvert, " & _
vbNewLine & " " & _
vbNewLine & "s.v.p. veuillez fermer le drj ! ": _
Windows(awn).Activate: Exit Sub

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe pas !":
_

Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
Selection.Copy

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Windows("revenus.xls").Activate ' section à améliorer

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:úlse
Windows(suf).Activate
ActiveSheet.Protect
ActiveWorkbook.save

ActiveWorkbook.Close
End Sub

.

bonjour, merci de votre aide, je vous redonne la macro que
j'ai testée, et sa ne fonctionne pas.
il semble avoir un problème sur la combinaison
awn = ThisWorkbook.Name ' pour nommé le fichier cible

et par la suite

Windows(awn).Activate'active le classeur cible

les données ne se colle pas!!!!

Public Sub TESTUP()
an = CInt(InputBox("Année ?", "Entrez l'année", Year(Now)))
mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour", Day(Now)))
dat = DateSerial(an, mo, da)

chemin = "C:revenus" & Format(dat, "yyyy") & "" &
Format(dat, "mmm")
chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"

fic = chemin & "" & suf

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _
fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant sil y a une erreur
awn = ThisWorkbook.Name 'emplacer ActiveWorkbook par
ThisWorkbook :
'Même renommé, la macro suit le classeur et Thisworkbook
fait toujours
'Référence au classeur qui contient son code
Err.Clear
On Error Resume Next
Windows(suf).Activate

If Err = 0 Then MsgBox suf & " est déjà ouvert, " & _
vbNewLine & " " & _
vbNewLine & "s.v.p. veuillez fermer le drj ! ":
Exit Sub

Windows(awn).Activate:
On Error GoTo 0 'pour être alerté si erreurs par la suite

'vérification dexistence
'présent Dir - nom, sinon - vide
If Dirfic = 0 Then MsgBox suf & "nexiste pas !":
Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
' Windowsawn.Activate ***la source des données si jai
bien compris
' ***doit être active pour que la copie sapplique aux
bonnes données
ActiveSheet.Unprotect
Application.Goto Reference:=F_B
'copie dans le classeur source
Selection.Copy

'active le classeur cible
Windows(awn).Activate
'collage des données
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=True,
Transpose:úlse
'enregistre et ferme la cible de la copie classeur drj
Workbooks(suf).Activate
ActiveSheet.Protect
Workbooks(suf).Close True
'***réactive, protège, enregistre et quitte le classeur
source
'***qui contient ce code
Windows(awn).Activate
ActiveSheet.Protect
'ActiveWorkbook.Close True
End Sub

-----Message d'origine-----
Bonsoir,

J'ai essayé de modifier ta macro en fonction de ce que
j'ai compris de ton

problème et de ton code. Les modifications proposées sont
commentées. A tester

(attention aux coupures de lignes provoquées par nos
logiciels de courriel) :

Sub upgradeF_B()

an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))

mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))

da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

'***petite correction : "C:revenus" au lieu
de "C:revenue"

chemin = "C:revenus" & Format(dat, "yyyy") & "" &
Format(dat, "mmmm")

chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"
fic = chemin & "" & suf

'***pourquoi cette demande puisqu'il ne faut pas que ce
fichier soit ouvert ?

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _

fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une erreur
awn = ThisWorkbook.Name '***remplacer ActiveWorkbook
par ThisWorkbook :

'***même renommé, la macro suit le classeur et
Thisworkbook fait toujours

'***référence au classeur qui contient son code
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then
MsgBox suf & " est déjà ouvert, " & vbNewLine & " " &
_

vbNewLine & "s.v.p. veuillez fermer le drj ! "
Exit Sub
End If
On Error GoTo 0 '***(pour être alerté si erreurs par la
suite)

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe pas !":
Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
Windows(awn).Activate '***la source des données (si
j'ai bien compris)

'***doit être active pour que la copie s'applique
aux 'bonnes' données

ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
'***copie dans le classeur source
Selection.Copy

'***active le classeur cible
Windows(suf).Activate
'***collage des données
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, _

Operation:=xlNone, SkipBlanks:=True,
Transpose:úlse

'***enregistre et ferme la cible de la copie (classeur
drj)

Workbooks(suf).Close True
'***réactive, protège, enregistre et quitte le classeur
source

'***(qui contient ce code)
Windows(awn).Activate
ActiveSheet.Protect
ActiveWorkbook.Close True
End Sub

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonjour, j'ai soumis se problème le 5 sept dernier j'ai
testé les réponses fournies mais ça ne fonctionne pas.
Je

pense que je n'ai pas assez donné d'explications sur le
problème à résoudre et j'en suis désolé. Parfois en
voulant être concis, cela
crée de la confusion.j'aide une amie à convertir des
fichiers lotus123 en excel. Voilà l'exposé de la
situation.

Voici le classement officiel des fichers:
C:revenus2003aoutaaout03.xls ' fichier où est la
macro

C:revenus2003aoutdrj0818.xls ' fichier où sont
copiés

les données.

La macro est écrite dans le fichier C:revenus2003
aoutaaout03.xls et le fichier est renommé une fois par
mois. C:revenus2003septasept03.xls. C:revenus2003
octaoct03.xls. etc. Elle sert à aller copier des
données dans le fichier drj. Il y a un nouveau fichier
drj

qui est créé tous les jours. C:revenus2003
septdrj0901.xls. C:revenus2003septdrj0902.xls.
etc.

Donc, à chaque jour, la macro est exécutée pour aller
chercher la nouvelle journée dans le «drj».

Initialement je pensais que le fichier de la macro était
toujours le même donc avec cette ligne: Windows
("revenus.«xls»").Activate
Tout fonctionnait bien. Mais j'ai appris cette semaine
que

le fichier hôte de la macro change à tous les mois. Et
de

plus sur le réseau où va être utilisé la macro ils ne
peuvent entrer plus de 8 caractères pour nommer les
fichers. Donc les mois doivent
être en date courte. Je pense comme cela mmm . Dans les
premiers jour du mois. Exemple le 1er sept, c'est le
fichiers C:revenus2003
aoutaaout03.xls qui est utilisé. Donc ont ne peut pas
dire que le fichier hôte porte automatiquement
l'extension

du mois courant.
Voilà il faut une solution pour que le code gère cette
situation.
Prévoir aussi que lorsque la personne exécute la macro
il

peut y avoir d'autres fichiers excel ouverts sur son
ordinateur.

Je vous redonne le code qui fonctionne à merveille sur
la

version excel xp et windows xp lorsque le fichier hôte
de

la macro n'est
pas renommé.
P.s petit ajustement supplémentaire à apporter. Lorsque
les inputbox me demandent de selectionner une année , un
mois et le jour. Si je réponds annuler à la question de
la

boîte la fenêtre de débogage s'ouvre!

Votre aide m'est très précieuse et j'ai déjà appliqué
des

brides de ce code dans plusieurs autres situations.

Est-ce que la solution serait de faire des inputbox pour
le fichier hôte!!!
Merci.

Sub upgradeF_B()



an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))
mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

chemin = "C:revenue" & Format(dat, "yyyy") & "" &
Format(dat, "mmmm")
chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"

fic = chemin & "" & suf

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _
fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une erreur
awn = ActiveWorkbook.Name
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then MsgBox suf & " est déjà ouvert, " & _
vbNewLine & " " & _
vbNewLine & "s.v.p. veuillez fermer le drj ! ": _
Windows(awn).Activate: Exit Sub

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe pas !":
_

Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
Selection.Copy

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Windows("revenus.xls").Activate ' section à améliorer

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:úlse
Windows(suf).Activate
ActiveSheet.Protect
ActiveWorkbook.save

ActiveWorkbook.Close
End Sub

.

-----Message d'origine-----
Bonsoir,

D'après ce que j'ai compris, awn contient le nom du
classeur *source* (soit

C:revenus2003aoutaaout03.xls de ton premier message)
et non pas le classeur

cible (qui est C:revenus2003aoutdrj0818.xls).
Ce classeur source est aussi celui où ta procédure
upgradeF_B est écrite et

ThisWorkbook fait bien référence au classeur qui contient
le code en cours

d'exécution.

Les modifications que tu as apportées à ma proposition
font, toujours si je

comprends bien, le contraire de ce que tu souhaites :

en commentant la ligne

' Windows(awn).Activate

c'est du coup le classeur cible (fic) qui est le classeur
actif (puisqu'on vient

de l'ouvrir) au moment de la copie des données. Le
classeur cible (ou il n'y a

sans doute rien, ou alors des données à remplacer) est
dès lors copié sur

lui-même.... ce qui n'est pas le résultat attendu.

EXACTEMENT

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

bonjour, merci de votre aide, je vous redonne la macro
que

j'ai testée, et sa ne fonctionne pas.
il semble avoir un problème sur la combinaison
awn = ThisWorkbook.Name ' pour nommé le fichier cible

et par la suite

Windows(awn).Activate'active le classeur cible

les données ne se colle pas!!!!

Public Sub TESTUP()
an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))

mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

chemin = "C:revenus" & Format(dat, "yyyy") & "" &
Format(dat, "mmm")
chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"

fic = chemin & "" & suf

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _
fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant sil y a une
erreur

awn = ThisWorkbook.Name 'emplacer ActiveWorkbook par
ThisWorkbook :
'Même renommé, la macro suit le classeur et
Thisworkbook

fait toujours
'Référence au classeur qui contient son code
Err.Clear
On Error Resume Next
Windows(suf).Activate

If Err = 0 Then MsgBox suf & " est déjà ouvert, " & _
vbNewLine & " " & _
vbNewLine & "s.v.p. veuillez fermer le drj ! ":
Exit Sub

Windows(awn).Activate:
On Error GoTo 0 'pour être alerté si erreurs par la
suite

'vérification dexistence
'présent Dir - nom, sinon - vide
If Dirfic = 0 Then MsgBox suf & "nexiste pas !":
Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
' Windowsawn.Activate ***la source des données si jai
bien compris
' ***doit être active pour que la copie sapplique aux
bonnes données
ActiveSheet.Unprotect
Application.Goto Reference:=F_B
'copie dans le classeur source
Selection.Copy

'active le classeur cible
Windows(awn).Activate
'collage des données
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=True,
Transpose:úlse
'enregistre et ferme la cible de la copie classeur drj
Workbooks(suf).Activate
ActiveSheet.Protect
Workbooks(suf).Close True
'***réactive, protège, enregistre et quitte le
classeur

source
'***qui contient ce code
Windows(awn).Activate
ActiveSheet.Protect
'ActiveWorkbook.Close True
End Sub

-----Message d'origine-----
Bonsoir,

J'ai essayé de modifier ta macro en fonction de ce que
j'ai compris de ton

problème et de ton code. Les modifications proposées
sont

commentées. A tester

(attention aux coupures de lignes provoquées par nos
logiciels de courriel) :

Sub upgradeF_B()

an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))

mo = CInt(InputBox("Mois ?", "Entrez le mois", Month
(Now)))

da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

'***petite correction : "C:revenus" au lieu
de "C:revenue"

chemin = "C:revenus" & Format(dat, "yyyy") & "" &
Format(dat, "mmmm")

chemin = Replace(Replace(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"
fic = chemin & "" & suf

'***pourquoi cette demande puisqu'il ne faut pas que
ce

fichier soit ouvert ?

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _

fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une
erreur

awn = ThisWorkbook.Name '***remplacer ActiveWorkbook
par ThisWorkbook :

'***même renommé, la macro suit le classeur et
Thisworkbook fait toujours

'***référence au classeur qui contient son code
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then
MsgBox suf & " est déjà ouvert, " & vbNewLine
& " " &

_

vbNewLine & "s.v.p. veuillez fermer le
drj ! "

Exit Sub
End If
On Error GoTo 0 '***(pour être alerté si erreurs par
la

suite)

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe pas !":
Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
Windows(awn).Activate '***la source des données (si
j'ai bien compris)

'***doit être active pour que la copie s'applique
aux 'bonnes' données

ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
'***copie dans le classeur source
Selection.Copy

'***active le classeur cible
Windows(suf).Activate
'***collage des données
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, _

Operation:=xlNone, SkipBlanks:=True,
Transpose:úlse

'***enregistre et ferme la cible de la copie
(classeur

drj)

Workbooks(suf).Close True
'***réactive, protège, enregistre et quitte le
classeur

source

'***(qui contient ce code)
Windows(awn).Activate
ActiveSheet.Protect
ActiveWorkbook.Close True
End Sub

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma
bal !

Bonjour, j'ai soumis se problème le 5 sept dernier
j'ai

testé les réponses fournies mais ça ne fonctionne
pas.

Je

pense que je n'ai pas assez donné d'explications sur
le

problème à résoudre et j'en suis désolé. Parfois en
voulant être concis, cela
crée de la confusion.j'aide une amie à convertir des
fichiers lotus123 en excel. Voilà l'exposé de la
situation.

Voici le classement officiel des fichers:
C:revenus2003aoutaaout03.xls ' fichier où est la
macro

C:revenus2003aoutdrj0818.xls ' fichier où sont
copiés

les données.

La macro est écrite dans le fichier C:revenus2003
aoutaaout03.xls et le fichier est renommé une fois
par

mois. C:revenus2003septasept03.xls.
C:revenus2003

octaoct03.xls. etc. Elle sert à aller copier des
données dans le fichier drj. Il y a un nouveau
fichier

drj

qui est créé tous les jours. C:revenus2003
septdrj0901.xls. C:revenus2003septdrj0902.xls.
etc.

Donc, à chaque jour, la macro est exécutée pour aller
chercher la nouvelle journée dans le «drj».

Initialement je pensais que le fichier de la macro
était

toujours le même donc avec cette ligne: Windows
("revenus.«xls»").Activate
Tout fonctionnait bien. Mais j'ai appris cette
semaine

que

le fichier hôte de la macro change à tous les mois.
Et

de

plus sur le réseau où va être utilisé la macro ils ne
peuvent entrer plus de 8 caractères pour nommer les
fichers. Donc les mois doivent
être en date courte. Je pense comme cela mmm . Dans
les

premiers jour du mois. Exemple le 1er sept, c'est le
fichiers C:revenus2003
aoutaaout03.xls qui est utilisé. Donc ont ne peut
pas

dire que le fichier hôte porte automatiquement
l'extension

du mois courant.
Voilà il faut une solution pour que le code gère
cette

situation.
Prévoir aussi que lorsque la personne exécute la
macro

il

peut y avoir d'autres fichiers excel ouverts sur son
ordinateur.

Je vous redonne le code qui fonctionne à merveille
sur

la

version excel xp et windows xp lorsque le fichier
hôte

de

la macro n'est
pas renommé.
P.s petit ajustement supplémentaire à apporter.
Lorsque

les inputbox me demandent de selectionner une
année , un

mois et le jour. Si je réponds annuler à la question
de

la

boîte la fenêtre de débogage s'ouvre!

Votre aide m'est très précieuse et j'ai déjà appliqué
des

brides de ce code dans plusieurs autres situations.

Est-ce que la solution serait de faire des inputbox
pour

le fichier hôte!!!
Merci.

Sub upgradeF_B()



an = CInt(InputBox("Année ?", "Entrez l'année",
Year

(Now)))
mo = CInt(InputBox("Mois ?", "Entrez le mois",
Month

(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

chemin = "C:revenue" & Format(dat, "yyyy") & ""
&

Format(dat, "mmmm")
chemin = Replace(Replace
(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"

fic = chemin & "" & suf

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _
fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une
erreur

awn = ActiveWorkbook.Name
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then MsgBox suf & " est déjà ouvert, "
& _

vbNewLine & " " & _
vbNewLine & "s.v.p. veuillez fermer le drj ! ": _
Windows(awn).Activate: Exit Sub

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe
pas !":

_

Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
Selection.Copy

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Windows("revenus.xls").Activate ' section à
améliorer

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:úlse
Windows(suf).Activate
ActiveSheet.Protect
ActiveWorkbook.save

ActiveWorkbook.Close
End Sub

.

.

-----Message d'origine-----
Re,

Mais encore ? :-)
Si tu as modifié le code proposé hier, c'est sans doute
qu'il ne t'aide pas à

règler pas ton problème et que tu as essayé de
l'adapter...

Tes explications étant déjà très détaillées, peut-être
que, si tes données ne

sont pas secret défense, un petit extrait de tes fichiers
de travail dans ma bal

pourrait permettre d'aller plus loin.

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

TU AS BIEN COMPRIT LA SITUATION

-----Message d'origine-----
Bonsoir,

D'après ce que j'ai compris, awn contient le nom du
classeur *source* (soit

C:revenus2003aoutaaout03.xls de ton premier
message)

et non pas le classeur

cible (qui est C:revenus2003aoutdrj0818.xls).
Ce classeur source est aussi celui où ta procédure
upgradeF_B est écrite et

ThisWorkbook fait bien référence au classeur qui
contient

le code en cours

d'exécution.

OUI TU AS RAISON

Les modifications que tu as apportées à ma proposition
font, toujours si je

comprends bien, le contraire de ce que tu souhaites :

en commentant la ligne

' Windows(awn).Activate

c'est du coup le classeur cible (fic) qui est le
classeur

actif (puisqu'on vient

de l'ouvrir) au moment de la copie des données. Le
classeur cible (ou il n'y a

sans doute rien, ou alors des données à remplacer) est
dès lors copié sur

lui-même.... ce qui n'est pas le résultat attendu.

EXACTEMENT

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma
bal !

bonjour, merci de votre aide, je vous redonne la
macro

que

j'ai testée, et sa ne fonctionne pas.
il semble avoir un problème sur la combinaison
awn = ThisWorkbook.Name ' pour nommé le fichier
cible

et par la suite

Windows(awn).Activate'active le classeur cible

les données ne se colle pas!!!!

Public Sub TESTUP()
an = CInt(InputBox("Année ?", "Entrez l'année", Year
(Now)))

mo = CInt(InputBox("Mois ?", "Entrez le mois",
Month

(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

chemin = "C:revenus" & Format(dat, "yyyy") & ""
&

Format(dat, "mmm")
chemin = Replace(Replace
(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"

fic = chemin & "" & suf

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _
fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant sil y a une
erreur

awn = ThisWorkbook.Name 'emplacer ActiveWorkbook
par

ThisWorkbook :
'Même renommé, la macro suit le classeur et
Thisworkbook

fait toujours
'Référence au classeur qui contient son code
Err.Clear
On Error Resume Next
Windows(suf).Activate

If Err = 0 Then MsgBox suf & " est déjà ouvert, "
& _

vbNewLine & " " & _
vbNewLine & "s.v.p. veuillez fermer le drj ! ":
Exit Sub

Windows(awn).Activate:
On Error GoTo 0 'pour être alerté si erreurs par la
suite

'vérification dexistence
'présent Dir - nom, sinon - vide
If Dirfic = 0 Then MsgBox suf & "nexiste pas !":
Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
' Windowsawn.Activate ***la source des données si
jai

bien compris
' ***doit être active pour que la copie sapplique
aux

bonnes données
ActiveSheet.Unprotect
Application.Goto Reference:=F_B
'copie dans le classeur source
Selection.Copy

'active le classeur cible
Windows(awn).Activate
'collage des données
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=True,
Transpose:úlse
'enregistre et ferme la cible de la copie classeur
drj

Workbooks(suf).Activate
ActiveSheet.Protect
Workbooks(suf).Close True
'***réactive, protège, enregistre et quitte le
classeur

source
'***qui contient ce code
Windows(awn).Activate
ActiveSheet.Protect
'ActiveWorkbook.Close True
End Sub

-----Message d'origine-----
Bonsoir,

J'ai essayé de modifier ta macro en fonction de ce
que

j'ai compris de ton

problème et de ton code. Les modifications proposées
sont

commentées. A tester

(attention aux coupures de lignes provoquées par nos
logiciels de courriel) :

Sub upgradeF_B()

an = CInt(InputBox("Année ?", "Entrez l'année",
Year

(Now)))

mo = CInt(InputBox("Mois ?", "Entrez le mois",
Month

(Now)))

da = CInt(InputBox("Jour ?", "Entrez le jour", Day
(Now)))

dat = DateSerial(an, mo, da)

'***petite correction : "C:revenus" au lieu
de "C:revenue"

chemin = "C:revenus" & Format(dat, "yyyy")
& "" &

Format(dat, "mmmm")

chemin = Replace(Replace
(chemin, "û", "u"), "é", "e")

suf = "drj" & Format(dat, "mmdd") & ".xls"
fic = chemin & "" & suf

'***pourquoi cette demande puisqu'il ne faut pas
que

ce

fichier soit ouvert ?

rep = MsgBox("Vous allez ouvrir le fichier :" &
vbNewLine & _

fic, vbYesNo + vbDefaultButton2, "Confirmation")

'attention, inversion de la condition !
If rep <> vbYes Then Exit Sub

'vérification de déjà ouvert
'on activate la fenêtre en regardant s'il y a une
erreur

awn = ThisWorkbook.Name '***remplacer
ActiveWorkbook

par ThisWorkbook :

'***même renommé, la macro suit le classeur et
Thisworkbook fait toujours

'***référence au classeur qui contient son code
Err.Clear
On Error Resume Next
Windows(suf).Activate
If Err = 0 Then
MsgBox suf & " est déjà ouvert, " & vbNewLine
& " " &

_

vbNewLine & "s.v.p. veuillez fermer le
drj ! "

Exit Sub
End If
On Error GoTo 0 '***(pour être alerté si erreurs
par

la

suite)

'vérification d'existence
'présent dir -> nom, sinon -> vide
If Dir(fic) = "" Then MsgBox suf & " n'existe
pas !":

Exit Sub

ChDrive (Left(chemin, 1))
ChDir chemin
Workbooks.Open Filename:=fic
Windows(awn).Activate '***la source des données
(si

j'ai bien compris)

'***doit être active pour que la copie s'applique
aux 'bonnes' données

ActiveSheet.Unprotect
Application.Goto Reference:="F_B"
'***copie dans le classeur source
Selection.Copy

'***active le classeur cible
Windows(suf).Activate
'***collage des données
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, _

Operation:=xlNone, SkipBlanks:=True,
Transpose:úlse

'***enregistre et ferme la cible de la copie
(classeur

drj)

Workbooks(suf).Close True
'***réactive, protège, enregistre et quitte le
classeur

source

'***(qui contient ce code)
Windows(awn).Activate
ActiveSheet.Protect
ActiveWorkbook.Close True
End Sub

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-
culottide]

Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma
bal !

Bonjour, j'ai soumis se problème le 5 sept dernier
j'ai

testé les réponses fournies mais ça ne fonctionne
pas.

Je

pense que je n'ai pas assez donné d'explications
sur

le

problème à résoudre et j'en suis désolé. Parfois
en

voulant être concis, cela
crée de la confusion.j'aide une amie à convertir
des

fichiers lotus123 en excel. Voilà l'exposé de la
situation.

Voici le classement officiel des fichers:
C:revenus2003aoutaaout03.xls ' fichier où est
la

macro

C:revenus2003aoutdrj0818.xls ' fichier où sont
copiés

les données.

La macro est écrite dans le fichier
C:revenus2003

aoutaaout03.xls et le fichier est renommé une
fois

par

mois. C:revenus2003septasept03.xls.
C:revenus2003

octaoct03.xls. etc. Elle sert à aller copier
des

données dans le fichier drj. Il y a un nouveau
fichier

drj

qui est créé tous les jours. C:revenus2003
septdrj0901.xls. C:revenus2003
septdrj0902.xls.

etc.

Donc, à chaque jour, la macro est exécutée pour
aller

chercher la nouvelle journée dans le «drj».

Initialement je pensais que le fichier de la macro
était

toujours le même donc avec cette ligne: Windows
("revenus.«xls»").Activate
Tout fonctionnait bien. Mais j'ai appris cette
semaine

que

le fichier hôte de la macro change à tous les
mois.

Et

de

plus sur le réseau où va être utilisé la macro
ils ne

peuvent entrer plus de 8 caractères pour nommer
les

fichers. Donc les mois doivent
être en date courte. Je pense comme cela mmm .
Dans

les

premiers jour du mois. Exemple le 1er sept, c'est
le

fichiers C:revenus2003
aoutaaout03.xls qui est utilisé. Donc ont ne
peut

pas

dire que le fichier hôte porte automatiquement
l'extension

du mois courant.
Voilà il faut une solution pour que le code gère
cette

situation.
Prévoir aussi que lorsque la personne exécute la
macro

il

peut y avoir d'autres fichiers excel ouverts sur
son

ordinateur.

Je vous redonne le code qui fonctionne à merveille
sur

la

version excel xp et windows xp lorsque le fichier
hôte

de

la macro n'est
pas renommé.
P.s petit ajustement supplémentaire à apporter.
Lorsque

les inputbox me demandent de selectionner une
année , un

mois et le jour. Si je réponds annuler à la
question

de

la

boîte la fenêtre de débogage s'ouvre!

Votre aide m'est très précieuse et j'ai déjà
appliqué

des

brides de ce code dans plusieurs autres
situations.

Est-ce que la solution serait de faire des
inputbox

pour

le fichier hôte!!!
Merci.

Sub upgradeF_B()



an = CInt(InputBox("Année ?", "Entrez l'année",
Year

(Now)))
mo = CInt(InputBox("Mois ?", "Entrez le mois",
Month

(Now)))
da = CInt(InputBox("Jour ?", "Entrez le jour",
Day