XL pour MAC Copier, Exporter, Sauvegarder

[nobodyuse]

Bonjour à tous

j'ai un classeur composé de plusieurs feuilles; 4 par Années comme suis (Janv2021, Mai2021, Sept2021 et Bilan2021, ....)
Depuis ma feuille Bilan2021 j'ai une macro qui convertie les résultats des formules en données afin d’être réutilisé a partir de Janv de l'année suivant ceci dans le but de pouvoir supprimer les feuilles de l'année passée

je cherche un moyen fiable d'automatiser au passage lors de l'utilisation de la macro de sauvegarder les feuilles Janv2021, Mai2021 et Sept2021 dans un nouveau classeur qui serai sauvegardé dans le même répertoire que le classeur initial (Sur serveur d'entreprise) et de supprimer les 3 feuilles précédemment de mon classeur actif.

en cherchant sur le forum j'ai trouvé quelques macro VBA que j'ai testé, mais soit elle me provoque une erreur 400, soit me crée et ouvre le nouveau classeur mais sans me le sauvegarder sans mon intervention dans mon dossier... pour l'instant pas de solution qui me conviennent.

voici la derniere macro en test (macro de copie te sauvegarde de Job75) mais j'ai une erreur 400

Sub ConvertFormulasToValuesInActiveWorksheet2021()
 ' protection de la macro par code
Dim strPw As String
strPw = "TOTO"

If InputBox("Saisissez le mot de passe", "Accès à la macro") <> strPw Then
MsgBox ("Mot de passe erroné")
Exit Sub
Else
MsgBox ("Mot de passe correct, les fonctions de sauvegarde et de conversion vont s'exécuter, cela peux prendre quelques minutes soyez patient !")
End If

'creation d'un nouveau fichier excel


Dim s As Object, lien, i&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Array("Janv2021", "Mai2021", "Sept2021")).Copy
With ActiveWorkbook
  For Each s In .Sheets: s.DrawingObjects.Delete: Next
  lien = .LinkSources
  If Not IsEmpty(lien) Then
    For i = 1 To UBound(lien)
      .BreakLink lien(i), xlExcelLinks
    Next
  End If
  .SaveAs ThisWorkbook.Path & "\Saveconsigneapoints2021", 51
  .Close
End With
ActiveCell.Activate



 '---message---
    Application.ScreenUpdating = True
    MsgBox "le fichier de sauvegarde a été créer, la convertion des données vas debuter "


' Transforme les formules en valeur brutes
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        If rng.HasFormula Then
            rng.Formula = rng.Value
        End If
    Next rng
    
     Application.ScreenUpdating = True
    MsgBox "sauvegarde et convertion terminé merci d'avoir patienté "
End Sub

 

[Staple1600]

Bonjour le fil

[Juste de passage pour une suggestion]
Ceci

' Transforme les formules en valeur brutes
ActiveSheet.UsedRange=ActiveSheet.UsedRange.Value

équivaut à ceci

' Transforme les formules en valeur brutes
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        If rng.HasFormula Then
            rng.Formula = rng.Value
        End If
    Next rng

 

[nobodyuse]

Bonjour le fil

[Juste de passage pour une suggestion]
Ceci

' Transforme les formules en valeur brutes
ActiveSheet.UsedRange=ActiveSheet.UsedRange.Value

équivaut à ceci

' Transforme les formules en valeur brutes
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        If rng.HasFormula Then
            rng.Formula = rng.Value
        End If
    Next rng

Bonjour Staple,
En effet ta formule donne effectivement le même résultat en bien plus rapide Merci

 

[nobodyuse]

pour revenir a mon problème initial
je patauge, j'ai fait pleins de test encore, ...

voila la formule qui me donne le meilleurs résultat
mais ce n'est pas hyper fiable, propre, et bon sang qu'est ce que c'est lent ...

Sub Convert2021()
 ' protection de la macro par code
Dim strPw As String
strPw = "ETNA"

If InputBox("Saisissez le mot de passe", "Accès à la macro") <> strPw Then
MsgBox ("Mot de passe erroné")
Exit Sub
Else
MsgBox ("Mot de passe correct, les fonctions de conversion des données de Septembre et la suppression des feuilles vont s'exécuter, soyez patient !")
End If

'creation d'un nouveau fichier excel

Dim Cl As Workbook
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Fe3 As Worksheet
Set Fe1 = Worksheets("Janv2021")
Set Fe2 = Worksheets("Mai2021")
Set Fe3 = Worksheets("Sept2021")
Application.ScreenUpdating = False
Set Cl = Workbooks.Add
With Cl
.SaveAs ("Saveconsigneapoints2021" & ".xlsx")
Fe1.Copy .ActiveSheet
ActiveSheet.Name = "SaveJanv2021"
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
Fe2.Copy .ActiveSheet
ActiveSheet.Name = "SaveMai2021"
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
Fe3.Copy .ActiveSheet
ActiveSheet.Name = "SaveSept2021"
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
Application.DisplayAlerts = False
.Worksheets("Feuil1").Delete
Application.DisplayAlerts = True
.Save
.Close
End With
Application.ScreenUpdating = True
Set Fe1 = Nothing
Set Fe2 = Nothing
Set Fe3 = Nothing
Set Cl = Nothing




' Transforme les formules en valeur brutes
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
    
        
     '---message---
         If MsgBox("Etes-vous certain de vouloir effacer les feuilles de Janvier, Mai et Septembre 2021 ?", vbYesNo, "Demande de confirmation") = vbYes Then
    ' Supprime les feuilles de l'année passé
Sheets(Array("Janv2021", "Mai2021", "Sept2021")).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
    End If
    
    
     Application.ScreenUpdating = True
    MsgBox "Sauvegarde, Suppression des feuilles de Janvier, Mai, Septembre et convertion des données terminé merci d'avoir patienté "
End Sub

 

[Staple1600]

Bonjour le fil

Je te laisse tester (sur une copie) mon interprétation de la chose.

Sub Convert2021_bis()
Dim i%, strPath$, Feuilles
strPath = ThisWorkbook.Path
'creation d'un nouveau fichier excel
Application.ScreenUpdating = False
Feuilles = Array("Janv2021", "Mai2021", "Sept2021")
Sheets(Feuilles).Move
For i = LBound(Feuilles) To UBound(Feuilles)
Sheets(Feuilles(i)).UsedRange = Sheets(Feuilles(i)).UsedRange.Value
Sheets(Feuilles(i)).Name = "Save" & Feuilles(i)
Next
ActiveWorkbook.SaveAs strPath & "\Saveconsigneapoints2021.xlsx"
Application.DisplayAlerts = False
ThisWorkbook.Close True
End Sub

NB: Comme c'est un test, j'ai viré ces histoires de mot de passe
Charge à toi de les remettre.

 

[nobodyuse]

Bonjour le fil

Je te laisse tester (sur une copie) mon interprétation de la chose.

Sub Convert2021_bis()
Dim i%, strPath$, Feuilles
strPath = ThisWorkbook.Path
'creation d'un nouveau fichier excel
Application.ScreenUpdating = False
Feuilles = Array("Janv2021", "Mai2021", "Sept2021")
Sheets(Feuilles).Move
For i = LBound(Feuilles) To UBound(Feuilles)
Sheets(Feuilles(i)).UsedRange = Sheets(Feuilles(i)).UsedRange.Value
Sheets(Feuilles(i)).Name = "Save" & Feuilles(i)
Next
ActiveWorkbook.SaveAs strPath & "\Saveconsigneapoints2021.xlsx"
Application.DisplayAlerts = False
ThisWorkbook.Close True
End Sub

NB: Comme c'est un test, j'ai viré ces histoires de mot de passe
Charge à toi de les remettre.

Merci Staple

j'ai testé mais c'est très très lent (mes pages sont sans doutes trop grosses)
après plusieurs grosses minutes j'ai un messages d'erreur "L'indice est en dehors des dimensions du tableau"

malgré ce message les pages Janv, Mai et Sept ont du être déplacé car ne sont plus sur mon fichier original.
Par contre le nouveau classeur n'ai pas dans le dossier...
en fait le classseur ne s'ouvre que lorsque je quitte le fichier initial .

 

[Staple1600]

Re

Moi, cela fonctionne sur mon fichier de test.
Fais de même, créés-toi un fichier Test
(avec 5 feuilles)
Allez, je te facilite la tâche pour créer l'exemple

Sub CREER_EXEMPLE()
Dim nbf%, t
With Application
    nbf = .SheetsInNewWorkbook
    .SheetsInNewWorkbook = 5
    Workbooks.Add
    .SheetsInNewWorkbook = nbf
End With
Randomize
t = Array(1, 5, 9)
For i = 1 To 3
X = Application.RandBetween(10, 30)
Sheets(i).Name = Application.Proper(Format(CDate("1-" & t(i - 1)), "mmmYYYY"))
Y = Application.RandBetween(5, 20)
Sheets(i).Cells(1).Resize(X, Y) = "=ADDRESS(ROW(),COLUMN(),4)"
Next
End Sub

Une fois ce classeur Exemple créé par la macro ci-dessus
Enregistres le en *.xlsm
Puis testes dessus la macro du message#5

Tu verras que cela fonctionne.

 

[job75]

Bonjour nobodyuse, JM,

Juste en passant.

voici la derniere macro en test (macro de copie te sauvegarde de Job75) mais j'ai une erreur 400

Je pense que même dans ma plus tendre enfance je n'aurais pas commis ce code du post #1 :

    For Each rng In ActiveSheet.UsedRange
        If rng.HasFormula Then
            rng.Formula = rng.Value
        End If
    Next rng

qui de plus est placé après la création du fichier !

Et juste une remarque : sur MAC le séparateur de chemin n'est pas l'antislash "\".

A+

 

[nobodyuse]

Re

Moi, cela fonctionne sur mon fichier de test.
Fais de même, créés-toi un fichier Test
(avec 5 feuilles)
Allez, je te facilite la tâche pour créer l'exemple

Sub CREER_EXEMPLE()
Dim nbf%, t
With Application
    nbf = .SheetsInNewWorkbook
    .SheetsInNewWorkbook = 5
    Workbooks.Add
    .SheetsInNewWorkbook = nbf
End With
Randomize
t = Array(1, 5, 9)
For i = 1 To 3
X = Application.RandBetween(10, 30)
Sheets(i).Name = Application.Proper(Format(CDate("1-" & t(i - 1)), "mmmYYYY"))
Y = Application.RandBetween(5, 20)
Sheets(i).Cells(1).Resize(X, Y) = "=ADDRESS(ROW(),COLUMN(),4)"
Next
End Sub

Une fois ce classeur Exemple créé par la macro ci-dessus
Enregistres le en *.xlsm
Puis testes dessus la macro du message#5

Tu verras que cela fonctionne.

Tout d'abord je suis épaté par votre facilité avec les codes VBA
purée ça m'a scotché ton code pour créer le fichier test

Effectivement cette fois la macro s’exécute immédiatement (La lenteur venait bien de mon fichier mais je m'en doutais)

Malheureusement j'ai eut le même soucis: Message, puis les feuilles disparaissent du classeur et seulement à la fermeture du fichier test le nouveau fichier apparait avec les feuilles deplacé, mais celui ci n'est pas sauvegardé il ce nomme "classeur 5"

 

[nobodyuse]

Bonjour nobodyuse, JM,

Juste en passant.

Je pense que même dans ma plus tendre enfance je n'aurais pas commis ce code du post #1 :

    For Each rng In ActiveSheet.UsedRange
        If rng.HasFormula Then
            rng.Formula = rng.Value
        End If
    Next rng

qui de plus est placé après la création du fichier !

Et juste une remarque : sur MAC le séparateur de chemin n'est pas l'antislash "\".

A+

Bonjour Job75
Houlala je ne m’étais pas relus c'est infecte ce que j'ai écris

donc je n'ai repris que la partie de code concernant la copie des feuilles du fichier le reste n’étant pas de vous évidemment mais vous l'aviez remarqué

la partie conversion des formules en données brutes est effectivement après la création de la copie car il ne concerne que la feuille bilan, et par prudence j'avais prévu de la mettre a la fin en cas de soucis de copie des feuilles.... après le code n'est ptet pas beau mais je débute avec Excel est encore plus avec le VBA (Soyez indulgent je ne me rend pas compte je n'ai pas vos talents), Staple a corrigé le codage merdique soit mais qui faisait le boulot quand même.

 

[Staple1600]

Re

Pour mon test, j'ai bien précisé qu'il fallait enregistré le classeur Exemple créé par la macro du message#7
(donc manuellement)
Et dans ce fichier Exemple, copier /coller la macro du message#5.

Mais comme le relève job75, tu es sous Mac, donc il faut adapter mon code en conséquence.

 

[Staple1600]

Re

Essaies avec cette modification.

Sub Convert2021_ter()
Dim i%, strPath$, Feuilles
strPath = ThisWorkbook.Path & Application.PathSeparator
'creation d'un nouveau fichier excel
Application.ScreenUpdating = False
Feuilles = Array("Janv2021", "Mai2021", "Sept2021")
Sheets(Feuilles).Move
For i = LBound(Feuilles) To UBound(Feuilles)
Sheets(Feuilles(i)).UsedRange = Sheets(Feuilles(i)).UsedRange.Value
Sheets(Feuilles(i)).Name = "Save" & Feuilles(i)
Next
ActiveWorkbook.SaveAs strPath & "Saveconsigneapoints2021.xlsx"
Application.DisplayAlerts = False
ThisWorkbook.Close True
End Sub

 

[nobodyuse]

Re

Pour mon test, j'ai bien précisé qu'il fallait enregistré le classeur Exemple créé par la macro du message#7
(donc manuellement)
Et dans ce fichier Exemple, copier /coller la macro du message#5.

C'est bien ce que j'ai fait j'ai suivi les consignes à la lettre

Mais comme le relève job75, tu es sous Mac, donc il faut adapter mon code en conséquence.

Le problème vient sans doute de Mac c'est bien possible :/
du coup dans ce cas précis difficile de créer un truc sous mac qui sera viable sur un serveur d'entreprise

avec la formulation du message #4 j'avais un semblant de résultat mais lent et pas fiable sur trois test une fois ça a été, la seconde cela n'avais pas effacé les formules pour les convertir en données brutes, et la troisième la page bilan avais été renommée
j'avais penser convertir en PDF mais arrivé a la page 48 j'ai préférer faire annuler
Je pense que je vais abandonner l'idée de l'archivage des pages, cela me parait trop compliqué

 

[nobodyuse]

Re

Essaies avec cette modification.

Sub Convert2021_ter()
Dim i%, strPath$, Feuilles
strPath = ThisWorkbook.Path & Application.PathSeparator
'creation d'un nouveau fichier excel
Application.ScreenUpdating = False
Feuilles = Array("Janv2021", "Mai2021", "Sept2021")
Sheets(Feuilles).Move
For i = LBound(Feuilles) To UBound(Feuilles)
Sheets(Feuilles(i)).UsedRange = Sheets(Feuilles(i)).UsedRange.Value
Sheets(Feuilles(i)).Name = "Save" & Feuilles(i)
Next
ActiveWorkbook.SaveAs strPath & "Saveconsigneapoints2021.xlsx"
Application.DisplayAlerts = False
ThisWorkbook.Close True
End Sub

c'est un truc de dingue quand même


ca me fait exactement la même chose: message> disparitions des feuilles > apparition du fichier seulement à la fermeture du fichier test

 

[Staple1600]

RE

C'est normal que les feuilles disparaissent...
Je ne fais que refaire ce que ton code faisait

  '---message---
         If MsgBox("Etes-vous certain de vouloir effacer les feuilles de Janvier, Mai et Septembre 2021 ?", vbYesNo, "Demande de confirmation") = vbYes Then
    ' Supprime les feuilles de l'année passé
Sheets(Array("Janv2021", "Mai2021", "Sept2021")).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete ' ici tu supprimais, non ?
Application.DisplayAlerts = True
    End If