Export Excel vers Word

Moon434

XLDnaute Nouveau
Bonjour à tous,

Est-il possible d'exporter des datas d'un onglet Excel vers un nouveau fichier .Word ?

Dans mon exemple en pièce jointe j'aurais besoin de :

Isoler les colonnes en jaune de mon fichier Excel (B, C,D,J,M) et les reporter sur un nouvel onglet. (Même classeur)
A partir de là je devrais retravailler un peu manuellement les données pour ne garder au final que deux colonnes. (Supposons pour le moment la D et la F.
Et enfin j'aurais besoin d'exporter le tout en .Word dans un nouveau fichier avec la mise en forme que je joins dans mon exemple Word. (Je ne peux pas joindre de fichier .Word j'ai donc mis un aperçu de ce que je voudrais sur un 3eme onglet du classeur)

Dans un premier temps, pouvez-vous me confirmer que cela est bien possible ?
Et si oui, une bonne âme est-elle prête à s'aventurer pour m'aider à la réalisation de ce projet ? :d

Merci par avance de vos réponses,

Moon./
 

Pièces jointes

  • PRIX vitrine.xlsx
    16.8 KB · Affichages: 44

kingfadhel

XLDnaute Impliqué
Bonjour le fil, bonjour le forum,

Code:
Sub Xlsx2DOCx()
Call Grouper
Call ToDocx
End Sub


Sub ToDocx()
    Dim DocWord As Object
    Dim objDoc As Object
    Set DocWord = CreateObject("Word.Application")
    DocWord.Visible = True
   
        Set DocWord = DocWord.Documents.Add()

    nbr1 = Range("A1").End(xlDown).Row
        ActiveSheet.Range("A1:E" & nbr1).Copy
   
        DocWord.Range.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
    wdInLine, DisplayAsIcon:=False
        Application.CutCopyMode = False
End Sub
Sub Grouper()
Dim nbsh As Integer
ActiveSheet.Name = "Source"
nbr = Range("A1").End(xlDown).Row
nbsh = Sheets.Count
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "XL2DC"

Sheets("Source").Range("B1:D" & nbr).Copy
Sheets("XL2DC").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Sheets("Source").Range("J1:J" & nbr).Copy
Sheets("XL2DC").Cells(1, 4).PasteSpecial Paste:=xlPasteValues
Sheets("Source").Range("M1:M" & nbr).Copy
Sheets("XL2DC").Cells(1, 5).PasteSpecial Paste:=xlPasteValues
Cells.Select
Cells.EntireColumn.AutoFit

End Sub

@+
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 924
Membres
101 841
dernier inscrit
ferid87