Problème sur macro d'enregistrement
Ttomax
Messages postés
64
Statut
Membre
-
Le Pingou Messages postés 12714 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12714 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Voici ma macro qui consiste à copier des données de ma page "fiche vierge" vers la dernière ligne disponible de ma feuille "suivi", jusque là tout va bien, je sélectionne ensuite ma case en fin de tableau qui me donne le nom de l'archive, puis je vérifie si le fichier existe pour soit coller une copie de ma fiche vierge dans le fichier existant ou soit le créer avec les cellules sélectionnées.
Et là ça ne marche plus, en fait j'avais effectué 2 macro soit pour utiliser un fichier existant ou pour en créer un nouveau, cela marche cependant j'essais de faire une seule commande mais cela ne marche pas, je pense que ma condition n'est pas bonne!!
< Sheets("Fiche vierge").Select
ActiveSheet.Unprotect
Range("AY8:CF8").Select
Selection.Copy
Sheets("suivi").Select
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True
Range("b1").Select
ActiveSheet.Protect
' Sélection de ma case pour définir le nom de l'archive
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 32).Select
' Vérification existance du fichier pour sauvegarde
If FichierExiste = Dir("C:\...\" & "ActiveCell" & ".xls") = "" Then
' Sélection format et feuille, copie vers nouveau fichier d'archivage, enregistrement du fichier
Sheets("Fiche vierge").Select
Sheets("Fiche vierge").Copy
ChDir "C:\...\"
ActiveWorkbook.SaveAs Filename:="C:\...\" & "Atelier " & [m4] & " archives " & Year(Date) & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
' Renomme la feuille par valeur de la case C4
ActiveSheet.Name = ActiveSheet.Range("c4").Value
Application.Run "'Suivi.xls'!Macro57"
Range("A1:O1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Workbooks.Open "C:\...\" & ActiveCell & ".xls"
Windows("Suivi.xls").Activate
Sheets("Fiche vierge").Select
Sheets("Fiche vierge").Copy Before:=Workbooks( _
"Atelier 4556 archives 2011.xls").Sheets(1)
Range("A1:O1").Select
' Renomme la feuille par valeur de la case C4
Range("A4").Select
ActiveSheet.Name = ActiveSheet.Range("c4").Value
Application.Run "'Suivi.xls'!Macro57"
Range("A1:O1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
ActiveWorkbook.Close>
Ma macro plante sur la ligne en gras en me signalant que le fichier est introuvable à l'adresse écrite.... alors que pour moi avec ma condition il devrait en créer un...
C'est un peu long tout ça mais si quelqu'un peu m'aider, ce serait cool, ca fait 3 jours que j'essais, ça me saoule :s, d'avance merci à mon sauveur ^^
Voici ma macro qui consiste à copier des données de ma page "fiche vierge" vers la dernière ligne disponible de ma feuille "suivi", jusque là tout va bien, je sélectionne ensuite ma case en fin de tableau qui me donne le nom de l'archive, puis je vérifie si le fichier existe pour soit coller une copie de ma fiche vierge dans le fichier existant ou soit le créer avec les cellules sélectionnées.
Et là ça ne marche plus, en fait j'avais effectué 2 macro soit pour utiliser un fichier existant ou pour en créer un nouveau, cela marche cependant j'essais de faire une seule commande mais cela ne marche pas, je pense que ma condition n'est pas bonne!!
< Sheets("Fiche vierge").Select
ActiveSheet.Unprotect
Range("AY8:CF8").Select
Selection.Copy
Sheets("suivi").Select
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True
Range("b1").Select
ActiveSheet.Protect
' Sélection de ma case pour définir le nom de l'archive
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 32).Select
' Vérification existance du fichier pour sauvegarde
If FichierExiste = Dir("C:\...\" & "ActiveCell" & ".xls") = "" Then
' Sélection format et feuille, copie vers nouveau fichier d'archivage, enregistrement du fichier
Sheets("Fiche vierge").Select
Sheets("Fiche vierge").Copy
ChDir "C:\...\"
ActiveWorkbook.SaveAs Filename:="C:\...\" & "Atelier " & [m4] & " archives " & Year(Date) & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
' Renomme la feuille par valeur de la case C4
ActiveSheet.Name = ActiveSheet.Range("c4").Value
Application.Run "'Suivi.xls'!Macro57"
Range("A1:O1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Workbooks.Open "C:\...\" & ActiveCell & ".xls"
Windows("Suivi.xls").Activate
Sheets("Fiche vierge").Select
Sheets("Fiche vierge").Copy Before:=Workbooks( _
"Atelier 4556 archives 2011.xls").Sheets(1)
Range("A1:O1").Select
' Renomme la feuille par valeur de la case C4
Range("A4").Select
ActiveSheet.Name = ActiveSheet.Range("c4").Value
Application.Run "'Suivi.xls'!Macro57"
Range("A1:O1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
ActiveWorkbook.Close>
Ma macro plante sur la ligne en gras en me signalant que le fichier est introuvable à l'adresse écrite.... alors que pour moi avec ma condition il devrait en créer un...
C'est un peu long tout ça mais si quelqu'un peu m'aider, ce serait cool, ca fait 3 jours que j'essais, ça me saoule :s, d'avance merci à mon sauveur ^^
A voir également:
- Problème sur macro d'enregistrement
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Enregistrement mp3 gratuit - Télécharger - Streaming audio
- Jitbit macro recorder - Télécharger - Confidentialité
- Enregistrement - Guide