XL 2013 Macro enregistrer une Copie de classeur

KTM

XLDnaute Impliqué
Salut chers tous
J'ai besoin d'une macro laquelle associée à un bouton va enregistrer mon fichier dans un sous-dossier de sauvegarde à l'emplacement du fichier d'origine.
Merci et à plus
 

job75

XLDnaute Barbatruc
Bonjour KTM, le forum,

Voici 2 solutions dans les 2 fichiers joints :

- la 1ère avec sauvegarde du fichier à l'identique (.xlsm) :
Code:
Sub SauvegardeXLSM()
Dim chemin$
chemin = ThisWorkbook.Path & "\Sauvegarde\" 'à adapter
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du sous-dossier
ThisWorkbook.SaveCopyAs chemin & ThisWorkbook.Name
End Sub
- la 2ème plus compliquée avec sauvegarde sans macro (.xlsx) ni bouton :
Code:
Sub SauvegardeXLSX()
If IsError(Application.Caller) Then Exit Sub 'sécurité
Dim chemin$, nom$
chemin = ThisWorkbook.Path & "\Sauvegarde\" 'à adapter
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du sous-dossier
ThisWorkbook.SaveCopyAs chemin & "µµµ.xlsm"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
nom = ThisWorkbook.Name
nom = Left(nom, InStrRev(nom, ".")) & "xlsx" 'nom avec extension xlsx
Workbooks(nom).Close 'sécurité
With Workbooks.Open(chemin & "µµµ.xlsm") 'ouverture du fichier sauvegardé
    .ActiveSheet.Shapes(Application.Caller).Delete 'suppession du bouton
    .SaveAs chemin & nom, 51 'enregistrement au format xlsx (sans macros)
    .Close
End With
Kill chemin & "µµµ.xlsm" 'suppression du fichier xlsm
End Sub
Bonne journée.
 

Pièces jointes

  • Classeur(1).xlsm
    25.9 KB · Affichages: 51
  • Classeur(2).xlsm
    27.3 KB · Affichages: 46
Dernière édition:

KTM

XLDnaute Impliqué
Merci énormément
Une autre Énigme que j'aimerais résoudre avec votre aide
Dans le fichier joint que je vais vous envoyé j'aimerais:
1- Chaque mois copier les quantités utilisées(Colonne F) de la feuille "RCM" et les coller en valeurs dans la colonne de la feuille "Consommations mensuelles" en fonction du mois indiqué en "H5" de la feuille "RCM".
Si vous pouvez aussi m'expliquer les bouts de code que vous utiliserez pour la macro ça sera super.
2- Inserer une formule dans la Colonne "P" de la feuille "Consommations mensuelles" pour calculer les CMM (moyenne des trois dernières
consommations )
Merci et à plus
 

Pièces jointes

  • Demo 1.1.1.xlsm
    35.6 KB · Affichages: 39

job75

XLDnaute Barbatruc
Re,

Bah vous aviez déjà posé les mêmes questions sur ce fil dimanche dernier :

https://www.excel-downloads.com/thr...es-donnees-dans-une-colonne-precise.20026359/

Alors voyez le fichier joint avec ce code dans la feuille "RCM" :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H5]) Is Nothing Or Not IsDate([H5]) Then Exit Sub
Dim t, d As Object, i&, col As Variant
If FilterMode Then ShowAllData 'si la feuille est filtrée
t = Range("A14:A" & Range("A" & Rows.Count).End(xlUp).Row + 13).Resize(, 10)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t) - 13
    If t(i, 1) <> "" Then d(t(i, 1)) = t(i, 10) 'mémorisation de la valeur en colonne J
Next
With Sheets("Consommations Mensuelles")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    col = Application.Match([H5], .Rows(3), 0)
    If IsNumeric(col) Then
        t = .Range("A5:A" & .Range("A" & .Rows.Count).End(xlUp).Row + 4).Resize(, col)
        For i = 1 To UBound(t) - 4
            t(i, col) = d(t(i, 1))
        Next
        If i > 1 Then .Cells(5, col).Resize(i - 1) = Application.Index(t, , col) 'restitution
    End If
    .Activate 'facultatif
End With
End Sub
Et cette formule en P5 de la feuille "Consommations Mensuelles" :
Code:
=SI(NB(C5:N5)<3;"";MOYENNE(INDEX(A5:N5;GRANDE.VALEUR(SI(ESTNUM(C5:N5);COLONNE(C5:N5));1));INDEX(A5:N5;GRANDE.VALEUR(SI(ESTNUM(C5:N5);COLONNE(C5:N5));2));INDEX(A5:N5;GRANDE.VALEUR(SI(ESTNUM(C5:N5);COLONNE(C5:N5));3))))
A+
 

Pièces jointes

  • Demo 1.1.1(1).xlsm
    44.6 KB · Affichages: 41

Discussions similaires