Exporter vers un modèle

Claudy · 12 Décembre 2007

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 · 13 Décembre 2007

Re : Exporter vers un modèle

Bonsoir,

A insérer dans ton fichier modele:

Code:

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 · 13 Décembre 2007

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 · 13 Décembre 2007

Re : Exporter vers un modèle

Bonjour,

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

Code:

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 · 22 Décembre 2007

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 · 23 Décembre 2007

Re : Exporter vers un modèle

Bonjour,

Tu peux faire un copier coller intégral:

Code:

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/

Exporter vers un modèle

Claudy

XLDnaute Accro

tirex28

XLDnaute Occasionnel

Claudy

XLDnaute Accro

tirex28

XLDnaute Occasionnel

Claudy

XLDnaute Accro

tirex28

XLDnaute Occasionnel

Discussions similaires

Exporter vers un modèle

Claudy

XLDnaute Accro

tirex28

XLDnaute Occasionnel

Claudy

XLDnaute Accro

tirex28

XLDnaute Occasionnel

Claudy

XLDnaute Accro

tirex28

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency