Sauvegarde d'un fichier impossible (VBA)

expender

XLDnaute Nouveau
Bonjour,

je me permets de vous solliciter, n'ayant pas trouvé de solution suite à de nombreuses recherches. Je cherche tout simplement à sauvegarder une fichier une fois que j'ai dupliqué des données dans ce dernier mais la sauvegarde ne marche pas.

Voici mon code :
Ce dernier récupère les valeurs d'une premier fichier, copie ces dernières vers une feuille "Temporaire" ou elles sont traitées et je récupère le résultat sur la feuille "Ranking. Je vais alors recopier ces résultats vers 3 fichiers appelés des maquettes à différents endroits.
La copie des datas marche très bien, mais dès lors que je boucle sur ma deuxième série à analyser ces dernières se "volatilisent", c'est pour cela que j'ai pensé à rajouter une étape de sauvegarde (qui ne marche pas non plus).

Merci d'avance pour votre temps et votre aide.

Code:
Windows(fichier).Activate
'On commence par faire une boucle sur chaque sheet du fichier
For Each i In ActiveWorkbook.Worksheets
    If (Len(i.Name) = 3) And (Left(i.Name, 1) = "F") Then
        'On cherche le nombre de facteurs et de valeurs par sheet
        Sheets(i.Name).Select
        NbVal = Range("B65536").End(xlUp).Row ' a deplacer ou val a prendre dans un autre fichier
        NbFonds = Range("VI1").End(xlToLeft).Column - 1 'on enleve 1 pour enlever la colonne des dates
        
        'Boucle sur les fonds à l'intérieur de chaque famille
        j = 2
        For j = 2 To NbFonds
            Windows(fichier).Activate
            Sheets("Temporaire").Cells.ClearContents
            Sheets(i.Name).Select
            Application.Calculation = xlCalculationManual
            ' Donne la correspondance des chiffres en colonnes, sur la table ASCII "A"= 65
            Select Case j
                Case Is <= 26
                    string_j = Chr(64 + j)
                Case Is > 26
                    string_j = Chr(64 + Int(((j - 1) / 26))) 'Retourne la première lettre
                    string_j = string_j & Chr(64 + 26 * (j / 26 - Int((j - 1) / 26))) ' Retourne la deuxième lettre
            End Select
            'On selectionne les datas puis on les copie afin d'obtenir le rang
            Range(string_j & "2:" & string_j & NbVal).Select
            Selection.Copy
            Sheets("Temporaire").Select
            Range("A2:A" & NbVal).Select
            Selection.PasteSpecial Paste:=xlValues
            Calculate
            'On recupere les datas avec le rang et les duplique vers les maquettes
            Sheets("Ranking").Select
            Range("C3:C" & NbVal).Select
            Selection.Copy
            'Ouverture et copie des données dans les 3 maquettes
            k = 1
            For k = 1 To 3
                fichiermaquette = "M" & k & "_" & etudeType & ".xls"
                Windows(fichiermaquette).Activate
                If fichiermaquette = "M3_w.xls" Then
                'Maquette 3
                    Sheets(i.Name).Select
                    Range(string_j & 41).Select
                   ' Selection.PasteSpecial Paste:=xlValue
                    Selection.Paste
                    'ActiveWorkbook.Save
                Else
                    'Maquette 1 et 2
                    Sheets(i.Name).Select
                    Range(string_j & 21).Select
                    'Selection.PasteSpecial Paste:=xlValue
                    ActiveSheet.Paste
                    'Selection.Paste
                    'Windows(fichiermaquette).Activate
                     '   ActiveWorkbook.Saved = True
                    'ActiveWorkbook.Close savechanges:=True
                    ActiveWorkbook.Save
                    'ThisWorkbook.Save
         
                    'ActiveSheets.Save
                End If
            Next k
        Next j
        Windows(fichier).Activate
    End If
Next i

J'ai testé différentes méthodes que j'ai d'ailleur laissé avec des ', mais ces dernières donnent toutes le même résultat.
 

camarchepas

XLDnaute Barbatruc
Re : Sauvegarde d'un fichier impossible (VBA)

Bonjour Expender, Hervé,

Alors pour les colonnes en Excel 2010 l'on est à XFD comme dernière colonnes , donc si le fichier n'a pas l'extension XLS, cela passe sans problème.

Voici le code corrigé un peu à l'aveugle (Avec tests mini ),puisque pas les données allant avec pour affiner les tests.

J'ai commencé par me refaire la déclaration de variables vu que le code n'est pas complet /

ATTENTION, dans les toutes premières lignes , j'ai initialisé la variable Fichier afin de faire des tests , il faudra la supprimer

J'ai supprimé les select ne servant qu'a perdre du temps et provoqué des erreurs surtout en cas de copie.

Pour la forme , j'ai remplacé le code de recherche de la lettre de la colonne, qui si on utilise l'offset ne sert à rien dans ce cas ci.

J'ai laissé toutes les lignes qui étaient commentées . mais y'a du ménage à faire.

Le windows(fichier).activate , n'est utile que si tu travailles sur plusieurs classeurs, sinon cela ne sert pas à grand chose. (De plus , je préfére workbooks(fichier).activate qui est me semble-t-il plus rigoureux)

Voilà.


Encore une chose , si tu es vraiment en Excel 2007 ou 2010 , il faut utiliser les bonnes extensions de fichier soit : xlsx pour les classeurs de données et xlsm pour les classeurs contenant du vba .(Sinon , cela provoque des erreurs car les objets feuille ne sont pas directement compatibles et donc transformer les modèles de feuilles en 2010

Ton code un peu revu , mais ne faisant pas ce que tu veux je pense

Code:
Option Explicit
Sub test()

Dim Fichier As String, String_J As String
Dim I As Worksheet
Dim NbVal As Long, NbFonds As Long
Dim J As Long
Dim K As Integer
Dim Etudetype As String, FichierMaquette As String

'Pour les besoin du test puisque le code n'est pas complet
Fichier = ThisWorkbook.Name

Windows(Fichier).Activate
'On commence par faire une boucle sur chaque sheet du fichier
For Each I In ActiveWorkbook.Worksheets
    If (Len(I.Name) = 3) And (Left(I.Name, 1) = "F") Then
      'On cherche le nombre de facteurs et de valeurs par sheet
        NbVal = Sheets(I.Name).Range("B65536").End(xlUp).Row ' a deplacer ou val a prendre dans un autre fichier
        NbFonds = Sheets(I.Name).Range("VI1").End(xlToLeft).Column - 1 'on enleve 1 pour enlever la colonne des dates
       
        'Boucle sur les fonds à l'intérieur de chaque famille
        For J = 2 To NbFonds
            Windows(Fichier).Activate
            Sheets("Temporaire").Cells.ClearContents
            Application.Calculation = xlCalculationManual
            ' Donne la correspondance des chiffres en colonnes, sur la table ASCII "A"= 65
             String_J = Split(Sheets(I.Name).Range("A1").Offset(0, J - 1).Address, "$")(1)

            'On copie les datas
            Sheets(I.Name).Range(String_J & "2:" & String_J & NbVal).Copy
            Sheets("Temporaire").Range("A2:A" & NbVal).PasteSpecial Paste:=xlValues
            Calculate
            'On duplique vers les maquettes
            Sheets("Ranking").Range("C3:C" & NbVal).Copy
            'Ouverture et copie des données dans les 3 maquettes
            For K = 1 To 3
                FichierMaquette = "M" & K & "_" & Etudetype & ".xls"
                Windows(FichierMaquette).Activate
                If FichierMaquette = "M3_w.xls" Then
                'Maquette 3
                    Sheets(I.Name).Range(String_J & 41).Paste
                   ' Selection.PasteSpecial Paste:=xlValue
                    'ActiveWorkbook.Save
                Else
                    'Maquette 1 et 2
                    Sheets(I.Name).Range(String_J & 21).Paste
                    'Selection.PasteSpecial Paste:=xlValue
                    'Selection.Paste
                    'Windows(fichiermaquette).Activate
                     '   ActiveWorkbook.Saved = True
                    'ActiveWorkbook.Close savechanges:=True
                    ActiveWorkbook.Save
                    'ThisWorkbook.Save
         
                    'ActiveSheets.Save
                End If
            Next K
        Next J
        Windows(Fichier).Activate
    End If
Next I
Application.Calculation = xlNormal
End Sub
 
Dernière édition:

expender

XLDnaute Nouveau
Re : Sauvegarde d'un fichier impossible (VBA)

Bonjour camarchepas,

je vais regarder avec attention les différentes modifications que tu as fais dans le fichier, surtotu l'utilisation de l'offset qui peut être moins lourd que mon select. Mon problème à la base est surtout de comprendre pourquoi le fichier n'enregistre pas les modifications que je fais.
 

expender

XLDnaute Nouveau
Re : Sauvegarde d'un fichier impossible (VBA)

Je pense avoir trouvé l'origine du problème, lors de mes paste, j'ai écris

Selection.PasteSpecial Paste:=xlValue
au lieu de
Selection.PasteSpecial Paste:=xlValues

Etrangement le programme a compilé sans rien me dire. Enfin maintenant ça marche, je n'ai plus qu'a faire du ménage dans mon code et à le rendre plus propre.

Merci à vous.
 

herve62

XLDnaute Barbatruc
Supporter XLD
Re : Sauvegarde d'un fichier impossible (VBA)

Bonsoir à tous
Expender , oui c'est vrai le compilateur passe OUTRE !!!! car il ne s'occupe que de la structure des instructions et mots CLE
Mais comme j'ai dis au début , quand j'écris "J'ai testé" , cela veut dire que je suis passé par le DEBOGAGE en Pas à PAs donc comme j'avais déjà eu une erreur , je me suis dis que c'était pas la peine de continuer car le Pg s'arrête , mais bon avec 2010 On peux aller LOIN en colonnes ( savait pas) , sinon je viens de Retester et encore ERREUR 1004 si tu mets VALUE au lieu de VALUES
Utilise + ce mode pour tes prochaines appli.... tu gagneras du temps , c'est le B A , ba comme partout
Bonne soirée
 

Discussions similaires

Réponses
3
Affichages
579

Statistiques des forums

Discussions
312 214
Messages
2 086 313
Membres
103 175
dernier inscrit
abcc