Conflit de noms de cellules dans un fichier lors du transfert de feuilles ...

Le
François
Bonjour à tous,

J'ai un fichier qui contient des binômes de feuilles (page de calendrier du
mois + page de gestion des vacances /RTT correspondante). Tous les mois
nouveaux sont créés par duplication du binôme de pages du dernier mois. Dans
ces feuilles, il y a des cellules nommées (ChampMFC1, ChampRest1 )
J'ai créé une macro pour archiver les feuilles périmées, qui va transférer
le binôme de feuilles dans un fichier du même nom mais précédé de "Old"
si ce fichier n'existe pas, il est alors créé sinon, le fichier Old
existant est ouvert, et le binôme de feuilles est transféré

Le problème : quand l'ancien fichier Old est ouvert, un binôme contenant
déjà toute une série de cellules nommées existe déjà. Lorsque le nouveau
binôme arrive avec des cellules pareillement nommées, Excel m'envoie une
MsgBox :
"Une feuille ou formule que vous déplacez contient le nom "ChampMFC1" qui
existe déjà sur la feuille de destination. Voulez-vous utiliser cette
version du nom ? Pour , cliquer su Oui Non et taper un nouveau nom
et le programme s'arrête quand on clique sur Oui par exemple !
J'ai pourtant inséré dans le programme un "Application.DisplayAlerts =
False", mais rien n'y fait !

Ce que j'aurai voulu faire, c'est faire coexister les noms sur le fichier
Old - comme c'est le cas sur le fichier mère - où les noms apparaissent sous
la forme :
ChampMFC1 Nov par Insérer/Nom de la feuille
Nov
ChampMFC1 Dec par Insérer/Nom de la feuille
Dec
ChampMFC1 Jan par Insérer/Nom de la feuille
Jan
etc

Comment contourner ce problème ? Je sèche !
Ci-dessous le programme (je peux si nécessaire mettre le fichier en Cjoint
)

Merci à tous

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As String,
annee As String
Dim repere As Byte, wsh As Worksheet

Application.ScreenUpdating = False
feuille = ActiveSheet.Name
feuille = InputBox("Enter the name of the calendar sheet to delete ",
"Sheet to transfer to the old file", feuille)
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
annee = Year([A2])
ChDir chemin
fichier = Dir("*.xls")
repere = 0

ChDir chemin
Do While Len(fichier) > 0
If fichier = "Old " & annee & " " & base Then
repere = 1
Workbooks.Open Filename:="Old " & annee & " " & base
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
End If
fichier = Dir
Loop

If repere = 0 Then
Application.DisplayAlerts = False
Sheets("Memoire").Visible = True
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then
Sheets(wsh.Name).Delete
End If
Next
Sheets("Memoire").Visible = xlVeryHidden
ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base
Workbooks.Open Filename:ºse
Workbooks(base).Sheets(feuille & ".list").Delete
Workbooks(base).Sheets(feuille).Delete
Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
François
Le #4684051
N.B. j'ai oublié de préciser que l'insertion de " On Error Resume Next "
empêche que le programme ne bloque, mais les feuilles ne sont alors pas
transférées ...


"François"
Bonjour à tous,

J'ai un fichier qui contient des binômes de feuilles (page de calendrier
du mois + page de gestion des vacances /RTT correspondante). Tous les mois
nouveaux sont créés par duplication du binôme de pages du dernier mois.
Dans ces feuilles, il y a des cellules nommées (ChampMFC1, ChampRest1 ...)
J'ai créé une macro pour archiver les feuilles périmées, qui va transférer
le binôme de feuilles dans un fichier du même nom mais précédé de "Old"
... si ce fichier n'existe pas, il est alors créé ... sinon, le fichier
Old existant est ouvert, et le binôme de feuilles est transféré ...

Le problème : quand l'ancien fichier Old est ouvert, un binôme contenant
déjà toute une série de cellules nommées existe déjà. Lorsque le nouveau
binôme arrive avec des cellules pareillement nommées, Excel m'envoie une
MsgBox :
"Une feuille ou formule que vous déplacez contient le nom "ChampMFC1" qui
existe déjà sur la feuille de destination. Voulez-vous utiliser cette
version du nom ? Pour ..., cliquer su Oui ... Non et taper un nouveau
nom...
et le programme s'arrête quand on clique sur Oui par exemple !
J'ai pourtant inséré dans le programme un "Application.DisplayAlerts =
False", mais rien n'y fait !

Ce que j'aurai voulu faire, c'est faire coexister les noms sur le fichier
Old - comme c'est le cas sur le fichier mère - où les noms apparaissent
sous la forme :
ChampMFC1 Nov par Insérer/Nom de la feuille
Nov
ChampMFC1 Dec par Insérer/Nom de la feuille
Dec
ChampMFC1 Jan par Insérer/Nom de la
feuille Jan
etc...

Comment contourner ce problème ? Je sèche !
Ci-dessous le programme (je peux si nécessaire mettre le fichier en Cjoint
...)

Merci à tous

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String
Dim repere As Byte, wsh As Worksheet

Application.ScreenUpdating = False
feuille = ActiveSheet.Name
feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
annee = Year([A2])
ChDir chemin
fichier = Dir("*.xls")
repere = 0

ChDir chemin
Do While Len(fichier) > 0
If fichier = "Old " & annee & " " & base Then
repere = 1
Workbooks.Open Filename:="Old " & annee & " " & base
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
End If
fichier = Dir
Loop

If repere = 0 Then
Application.DisplayAlerts = False
Sheets("Memoire").Visible = True
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name wsh.Name <> "Memoire" Then
Sheets(wsh.Name).Delete
End If
Next
Sheets("Memoire").Visible = xlVeryHidden
ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base
Workbooks.Open Filename:ºse
Workbooks(base).Sheets(feuille & ".list").Delete
Workbooks(base).Sheets(feuille).Delete
Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub




Publicité
Poster une réponse
Anonyme