Copier/coller Excel Word

Bonjour chers forumistes ,



J'ai une dificulté à transférer un grand tableau excel ( ci-joint ) vers un nvx doc word , tout on respectant les régles suivante :

* couper le tableau en plusieurs tablette de 12 colonne chacune ( voir fichier joint)

* coller les tableaux l'un aprés l'autre on gardant la premiére colonne (contenant la signification de chaque ligne) toujours au début de chaque tableau

*Chaque tableau est l'enssemble des cellule depuis la ligne 3 et jusqu'à la ligne 26 et sa largeur et de 12 colonne + la premiére

*Le code doit etre placé dans la feuil excel contenant les tableau

* activer le fichier word et fermer le classeur excel

Le fichier joint contient le classeur excel contenant le tableau à recopier dans word et un exemple dans word de l'application faite manuellement .

Je suis vraiment bloqué et c'est à vous de m'aider comme d'habitude

Un grand merci d'avance !!

Voilà le code que j'ai développé en prmeir temps

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

Private Sub CommandButton1_Click()   Dim WordApp As Word.Application Dim WordDoc As Word.Document Dim Fichier As String Dim A As Variant   A = Application.GetOpenFilename()     'le document Word est supposé fermé avant le lancement de la macro Fichier = "A"   ' Si Le fichier n'est pas selectionné "msgbox" :D   If A = False Then MsgBox " Aucun fichier n'a été selectionné"   Else   'necessite d'activer la reference Microsoft Word xx.x Object Library   Set WordApp = New Word.Application   WordApp.Visible = True   Set WordDoc = WordApp.Documents.Open(A)     ActiveSheet.Range("A3:P26").Select   Selection.Copy   WordApp.Activate     WordDoc.Paragraphs.Add   WordApp.Selection.PasteSpecial   ThisWorkbook.ActiveSheet.Select   ActiveSheet.Range("A3:A24,Q3:AG24").Select Selection.Copy     Dim i As Variant For i = 1 To WordDoc.Tables.Count   WordDoc.Tables(i).AutoFitBehavior wdAutoFitWindow WordDoc.Tables(i).Select Selection.VerticalAlignment = wdCellAlignVerticalCenter   Next i       Application.CutCopyMode = True   WordDoc.Close   'ferme l'application Word   WordApp.Quit   End If   End Sub

---

Bonjour
Je viens de faire cela rapidement
A mettre dans le code de la feuille
-Mettre un BP "CommandButton1" dans la feuille
-De bien cocher dans Visual Outils/référence: microsoft word 12.0 objet library
-De mettre des signets dans tes feuilles word pour positionner les morceaux de tableau
A+ Franc

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50

'cochez la référence Microsoft Word 12.0 Object Library Private Sub CommandButton1_Click()   Dim oWord As Word.Application 'Créer une instance de word Set oWord = CreateObject("Word.Application")   'Copier une plage depuis Excel Range("B6:D21").Select   Selection.Copy   'Ouvrir un nouveau document oWord.Documents.Open "D:\Document1.docx"   'rendre le document word visible oWord.Visible = True   'cherche le signet dans la feuille word oWord.Selection.GoTo What:=wdGoToBookmark, Name:="Signet1"   'Coller la plage dans Word oWord.Selection.PasteAndFormat (wdPasteDefault)   'aligne le tableau au milieu de la page oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter   Range("E6:G21").Select Selection.Copy   oWord.Selection.GoTo What:=wdGoToBookmark, Name:="Signet2"   oWord.Selection.PasteAndFormat (wdPasteDefault)   oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter   Range("H6:J21").Select Selection.Copy   oWord.Selection.GoTo What:=wdGoToBookmark, Name:="Signet3"   oWord.Selection.PasteAndFormat (wdPasteDefault)   oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter     'Annuler le mode couper/copier Application.CutCopyMode = False   End Sub

---