Exporter vers un modèle

[Claudy]

Bonsoir,
Un dossier avec les fichiers: fruits.xls, légumes.xls, viandes.xls,
boissons.xls et Modèle.xls (En réalité il y a +/- 20 fichiers).
Tous ces fichiers présentent la même structure: une feuille Cordonnées, une
Database et d'autres feuilles semblables....
Est il possible au départ de mon fichier Modèle.xls par fichier :
Tout en gardant ce qui a été fait dans Modèle.xls(Formats, macro,
protections, etc..)
d'exporter le contenu (Range(B2:H5000)de la feuille Database du fichier
ainsi que la feuille Cordonnées) vers mon fichier modèle.xls et de le
renommer comme son prédécesseur(Viandes, fruits, etc...)?
Merci d'avance,
Claudy

 

[tirex28]

Re : Exporter vers un modèle

Bonsoir,

A insérer dans ton fichier modele:

Sub RecupDonnees()
    Dim Source As Range, Destination As Range
    
    Set Source = Workbooks("Fruits.xls").Worksheets("Database").Range("B2:H5000")
    
    Set Destination = ThisWorkbook.Worksheets("Database").Range("B2:H5000")

    Destination.Value = Source.Value

    Workbooks("Fruits.xls").Close

    ThisWorkbook.SaveAs "Fruits.xls"
End Sub

Il faudra peut etre (sans doute) affiner selon tes besoins (gestion des protections, des chemins d'acces ou des fichiers ouverts etc).

Cordialement,

Tirex28/

 

[Claudy]

Re : Exporter vers un modèle

Ok, merci
Mais si je veux automatiser à tous les classeurs (fruits.xls, légumes.xls, viandes.xls etc...) contenu dans mon répertoire "Gestion"?
Un peu dans le genre:

For each clas in répertoire"Gestion"
Set Source = clas.Worksheets("Database").Range("B2:H5000")

Set Destination = ThisWorkbook.Worksheets("Database").Range("B2:H5000")

Destination.Value = Source.Value

clas.Close

ThisWorkbook.SaveAs "Fruits.xls"



next

Merci d'avance,
Claudy

 

[tirex28]

Re : Exporter vers un modèle

Bonjour,

Adapte le chemin d'acces, et par prudence à tester d'abord sur une copie de tes fichiers.

Sub RecupDonnees()
    Dim Source As Range, Destination As Range
    Dim NomFichier As String, Chemin As String

    Chemin = "C:\Documents and Settings\User\Mes documents\"
    NomFichier = Dir(Chemin & "*.xls")
    Application.DisplayAlerts = False
    Do Until NomFichier = vbNullString
        Workbooks.Open Chemin & NomFichier
        Set Source = Workbooks(NomFichier).Worksheets("Database").Range("B2:H5000")
        Set Destination = ThisWorkbook.Worksheets("Database").Range("B2:H5000")
        Destination.Value = Source.Value
        Workbooks(NomFichier).Close
        ThisWorkbook.SaveAs Chemin & NomFichier
        NomFichier = Dir
    Loop
    Application.DisplayAlerts = True
End Sub

Cordialement,

Tirex28/

 

[Claudy]

Re : Exporter vers un modèle

Destination.Value = Source.Value

Bonsoir et merci,

Ce code me va très bien...mais après plusieurs essais,
il serait bon aussi de transposer le format, dans le genre:

Destination.Format = Source.format

Est ce possible?
Merci et bonnes fêtes.

 

[tirex28]

Re : Exporter vers un modèle

Bonjour,

Tu peux faire un copier coller intégral:

Sub RecupDonnees()
    Dim Source As Range, Destination As Range
    Dim NomFichier As String, Chemin As String

    Chemin = "C:\Documents and Settings\User\Mes documents\"
    NomFichier = Dir(Chemin & "*.xls")
    Application.DisplayAlerts = False
    Do Until NomFichier = vbNullString
        Workbooks.Open Chemin & NomFichier
        Set Source = Workbooks(NomFichier).Worksheets("Database").Range("B2:H5000")
        Set Destination = ThisWorkbook.Worksheets("Database").Range("B2:H5000")
        'Destination.Value = Source.Value
        [B]Source.Copy Destination[/B] 'Copier-coller
        Workbooks(NomFichier).Close
        ThisWorkbook.SaveAs Chemin & NomFichier
        NomFichier = Dir
    Loop
    Application.DisplayAlerts = True
    Application.CutCopyMode = False 'Vide le presse papier
End Sub

Cordialement,

Tirex28/