Macro Sauvegarde de données dans un fichier Excel : Problème de compilation

Banshor

XLDnaute Nouveau
Bonjour,

j'ai débuté un code pour ma macro (sans connaissance dans la programmation). Ma macro sert à enregistrer le fichier sous un certain nom dans un dossier qu'elle crée si il n'existe pas puis récupérer certaines information afin de les transférer dans un fichier d'Archivage à la suite des autres informations sauvegardé. Puis ré-ouvre le fichier de base vide à remplir. Ce qui donnerais sur le fichier d'Archivage quelque chose comme cela :

ExempleFichierArchivage.jpg

Et ma feuille source ressemble à cela : (les valeurs entourées de rouge sont celles à archiver)

Archivage des valeurs en rouge.jpg

Actuellement mon code ressemble à cela :

Code:
Sub ChangementOF()
    Dim Chemin$, Nom$, Fichier$, Dossier$, CheminArchivage$, NomArchivage$, FichierArchivage$, DossierArchivage$
    Dim DerLg As Long
    Chemin = "U:\Projet David\"
    Nom = Range("K2")
    Fichier = Nom & ".xls"
    Dossier = Range("L1")
    CheminArchivage = "U:\Projet David\Archivage 2014"
    NomArchivage = "Archivage"
    FichierArchivage = Nom & ".xls"
    DossierArchivage = Range("L2")
    ClasseurArchivage = "U:\Projet David\Archivage 2014\Archivage.xls"
  'Selectionne le chemin et sauvegarde dans le dossier spécifier ou le crée si il est inexistant
    If Dir(Chemin & Dossier, 16) = "" Then MKDIR Chemin & Dossier
    ActiveWorkbook.SaveAs Chemin & Dossier & "\" & Fichier
  'Copie les valeurs nécessaire dans le fichier d'archivage
    With Workbook("Archivage.xls").Sheets("ArchiveBase")
    DerLg = .Range("A" & .Rows.Count).End(xlUp).Row + 1
      .Range("A" & DerLg) = Workbook(Fichier).Range("B11")
      .Range("D" & DerLg) = Workbook(Fichier).Range("L5")
      .Range("F" & DerLg) = Workbook(Fichier).Range("G11")
      .Range("H" & DerLg) = Workbook(Fichier).Range("F26")
      .Range("K" & DerLg) = Workbook(Fichier).Range("I51")
    End With
    ActiveWorkbook.Save
  'Réouvre le fichier Excel de base
    Workbooks.Open Filename:="U:\Projet David\TEST TEST.xls"
  'Placer le fichier de base comme actif
    Workbooks("TEST TEST").Activate
  'Repositionnement de la cellule selectionné sur l'OF à remplir
    Range("B11").Select
End Sub

J'ai un soucis dans cette partie de mon code :

Code:
'Copie les valeurs nécessaire dans le fichier d'archivage
    With Workbook("Archivage.xls").Sheets("ArchiveBase")
    DerLg = .Range("A" & .Rows.Count).End(xlUp).Row + 1
      .Range("A" & DerLg) = Workbook(Fichier).Range("B11")
      .Range("D" & DerLg) = Workbook(Fichier).Range("L5")
      .Range("F" & DerLg) = Workbook(Fichier).Range("G11")
      .Range("H" & DerLg) = Workbook(Fichier).Range("F26")
      .Range("K" & DerLg) = Workbook(Fichier).Range("I51")
    End With
    ActiveWorkbook.Save

j'ai un message d'erreur (Erreur de compilation : Sub ou fonction non définie).

Il me surligne en jaune

Code:
Sub ChangementOF()

Et me sélectionne le mot Workbook dans

Code:
With Workbook("Archivage.xls").Sheets("ArchivageBase")

je ne sais pas comment faire actuellement. J'ai tenté d'ajouter :

Code:
Dim wb As Workbook

et modifier tous les Workbook en wb car j'avais vu ça.. Sans succès. Je m'essaye à différentes choses sans réellement savoir ce que je fais!

Merci de m'aider s'il vous plaît !
 
Dernière édition:

Banshor

XLDnaute Nouveau
Re : Macro Sauvegarde de données dans un fichier Excel : Problème de compilation

J'ai un peu plus avancé. Voici mon code si je ne devais recopier qu'une seule cellule par exemple

Code:
Windows(Fichier).Activate
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Open Filename:=ClasseurArchivage
    Windows("Archivage.xls").Activate
    If Range("A2").Value = "" Then
    ActiveSheet.Paste
    Else
    Range("A2").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    End If

j'ai une erreur à la ligne

Code:
Range("A2").End(xlDown).Offset(1, 0).Select

Erreur d'exécution '1004': Erreur définie par l'application ou par l'objet

Et je comptais reproduire cela 5 fois ayant 5 valeurs à recopier.
 

Discussions similaires

Réponses
7
Affichages
321

Statistiques des forums

Discussions
312 203
Messages
2 086 194
Membres
103 153
dernier inscrit
SamirN