Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Sub
re bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelle
Isabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.
bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelle
Je reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+
Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Sub
re bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelle
Isabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.
bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelle
Je reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Salut AnonymousA,
il n'y a pas de problème quant à ta venue. Tu m'en vois désolé mais je n'ai
rien reçu de ta part. Je te redonne mon adresse :
J'insiste sur mon problème car je n'ai toujours pas trouvé de solution.
J'imagine que mon PC doit être réfractaire à ma macro si chez toi elle
fonctionne correctement. Je vais finir par aller élever des chèvres dans
l'Ardèche, ... dès qu'il fera beau ! Je parviendrai peut-être à les
comprendre, elles. =-(
A+
Thierry.bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Salut AnonymousA,
il n'y a pas de problème quant à ta venue. Tu m'en vois désolé mais je n'ai
rien reçu de ta part. Je te redonne mon adresse : thierry.janvier@unilever.com
J'insiste sur mon problème car je n'ai toujours pas trouvé de solution.
J'imagine que mon PC doit être réfractaire à ma macro si chez toi elle
fonctionne correctement. Je vais finir par aller élever des chèvres dans
l'Ardèche, ... dès qu'il fera beau ! Je parviendrai peut-être à les
comprendre, elles. =-(
A+
Thierry.
bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+
Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Sub
re bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelle
Isabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.
bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelle
Je reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Salut AnonymousA,
il n'y a pas de problème quant à ta venue. Tu m'en vois désolé mais je n'ai
rien reçu de ta part. Je te redonne mon adresse :
J'insiste sur mon problème car je n'ai toujours pas trouvé de solution.
J'imagine que mon PC doit être réfractaire à ma macro si chez toi elle
fonctionne correctement. Je vais finir par aller élever des chèvres dans
l'Ardèche, ... dès qu'il fera beau ! Je parviendrai peut-être à les
comprendre, elles. =-(
A+
Thierry.bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Salut AnonymousA,
il n'y a pas de problème quant à ta venue. Tu m'en vois désolé mais je n'ai
rien reçu de ta part. Je te redonne mon adresse :
J'insiste sur mon problème car je n'ai toujours pas trouvé de solution.
J'imagine que mon PC doit être réfractaire à ma macro si chez toi elle
fonctionne correctement. Je vais finir par aller élever des chèvres dans
l'Ardèche, ... dès qu'il fera beau ! Je parviendrai peut-être à les
comprendre, elles. =-(
A+
Thierry.bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Salut AnonymousA,
il n'y a pas de problème quant à ta venue. Tu m'en vois désolé mais je n'ai
rien reçu de ta part. Je te redonne mon adresse : thierry.janvier@unilever.com
J'insiste sur mon problème car je n'ai toujours pas trouvé de solution.
J'imagine que mon PC doit être réfractaire à ma macro si chez toi elle
fonctionne correctement. Je vais finir par aller élever des chèvres dans
l'Ardèche, ... dès qu'il fera beau ! Je parviendrai peut-être à les
comprendre, elles. =-(
A+
Thierry.
bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+
Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Sub
re bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelle
Isabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.
bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelle
Je reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
Salut AnonymousA,
il n'y a pas de problème quant à ta venue. Tu m'en vois désolé mais je n'ai
rien reçu de ta part. Je te redonne mon adresse :
J'insiste sur mon problème car je n'ai toujours pas trouvé de solution.
J'imagine que mon PC doit être réfractaire à ma macro si chez toi elle
fonctionne correctement. Je vais finir par aller élever des chèvres dans
l'Ardèche, ... dès qu'il fera beau ! Je parviendrai peut-être à les
comprendre, elles. =-(
A+
Thierry.bonjour,
je ne vais pas m'immiscer dans le fil que tu as avec Isabelle mais tu avais
déjà évoqué ce problème la semaine dernière et tu m'avais envoyé tes fichiers
. Je n'avais pas pu reproduire sur mon PC le phénomène que tu décrivais mais
t'avais renvoyé tes fichiers avec quelques indications.
avais-tu reçu mon envoi de Dimanche ?
A+Bonjour Isabelle,
Voici ma macro dans son intégralité. J'ai même essayé d'intégrer l'ouverture
du fichier dans une boucle du type do.... loop until, mais la macro s'arrête
quand même ! Dans la macro ci-dessous, j'ai ajouté des commentaires qui ne
figurent pas dans ma macro pour la rendre (j'espère !) aisément
compréhensible.
A+
Thierry
Sub RecuperationNbreCaristes()
' RecuperationNbreCaristes Macro
' Macro enregistrée le 14/02/05 par Thierry JANVIER
' Touche de raccourci du clavier: Ctrl+Maj+R
'
Application.ScreenUpdating = False
Dim NumSem As String
Dim NomOngl As String
Dim NumJour As String
Dim NumMois As String
' Boucle demandant le nième jour compris entre 1 et 31
Do
NumJour = InputBox("Taper le numéro de jour entre 1 et 31", "Le jour
?")
If NumJour = "" Then Exit Sub
Loop Until NumJour >= 1 And NumJour <= 31
' pour faire un nom de jour à 2 chiffres
If NumJour < 10 Then NumJour = "0" & NumJour
' Boucle demandant le nième mois compris entre 1 et 12
Do
NumMois = InputBox("Taper le numéto de mois entre 1 et 12", "Le mois
?")
If NumMois = "" Then Exit Sub
Loop Until NumMois >= 1 And NumMois <= 12
' Pour faire un nom de mois à 2 chiffres
If NumMois < 10 Then NumMois = "0" & NumMois
' le fichier s'appelle, exemple pour cette semaine SEM 09.xls
' avec des onglets qui s'appellent "lundi 28.02", "mardi 01.03", mercredi
02.03" etc
' AA5 calcule le nom du jour de la semaine et AA4 la nième semaine de l'année
NomOngl = Range("AA5").Value & " " & NumJour & "." & NumMois
NumSem = Range("AA4").Value
If NumSem < 10 Then NumSem = "0" & NumSem
' Un message pour rappeler à l'utilisateur ce dont il veut
MsgBox "Semaine : " & NumSem & Chr(10) & "Onglet : " & NomOngl,
vbExclamation, "De la rigueur est demandée !"
NomFic = ("SEM " & NumSem & ".xls")
Set FicDep = ThisWorkbook
' Je teste maintenant la présence du fichier qui s'appelle NomFic
Dim LeRep$
LeRep = ("H:EFFECTIF DES GROUPES CLPoint des journées 2005")
Dim LaFen As Window
Dim Trouve As Boolean
A = 0
For Each LaFen In Application.Windows
If LaFen.Caption = NomFic Then
Trouve = True
LaFen.Activate: Exit For
Else: Trouve = False: End If
Next LaFen
' If Not Trouve Then _
MsgBox "Fichier non ouvert. La macro sera à relancer après ouverture
du fichier"
If Trouve = False Then
Do
MsgBox "Fichier non ouvert !"
Workbooks.Open (LeRep & Application.PathSeparator & NomFic)
FicDep.Activate
A = A + 1
Loop Until A = 1
End If
' Ci dessus, la macro s'arrête après l'ouverture de NomFic et ne fait pas
FicDep.Activate !
' début des copier-coller entre les 2 fichiers
CestParti:
Windows(NomFic).Activate
On Error GoTo JourErreur
Sheets(NomOngl).Select
Range("C77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AE2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G77").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AG2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("C68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AI2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Windows(NomFic).Activate
Range("G68").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nx05 en prépa.xls").Activate
Range("AK2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Application.ScreenUpdating = True
GoTo Bravo:
' Traitement de l'erreur si l'onglet du fichier source n'existe pas
JourErreur:
MsgBox "L'onglet ' " & NomOngl & " ' n'existe pas !", vbCritical
Exit Sub
' Grand sourire pour moi quand je vois à l'écran le message qui suit
Bravo:
MsgBox "Voilà, c'est fini...."
End Subre bonjour Thierry,
il faudrais que je voie la macro pour assayé de découvrir d'ou provient
l'erreur.
a+
isabelleIsabelle, merci beaucoup de ton aide.
La macro exécute bien l'ouverture du fichier, mais s'arrête juste après,
c'est-à-dire que monFichier1.Activate ne se fait pas.
A demain,
Thierry.bonjour Thierry,
Set monFichier1 = ThisWorkbook
Workbooks.Open ("C:ssrepFichierACopier")
monFichier1.Activate
isabelleJe reviens à la charge car je n'ai toujours pas trouvé de solution.
J'ai une macro dans un fichier Excel qui va copier des cellules dans un
autre fichier excel pour être collées dans le 1er fichier. En début de macro,
je teste si ce 2ème fichier est ouvert. S'il l'est, alors la macro s'exécute
jusqu'au bout, mon fichier de départ restant actif. S'il ne l'est pas, la
macro ouvre le fichier où sont les cellules à copier mais s'arrête juste
après en me laissant à l'écran le fichier qui vient d'être ouvert. J'utilise :
Workbooks.Open ("C:ssrepFichierACopier")
Thierry.
