Bonjour,
Je vous propose la solution suivante, elle consiste en une macro et une fonction à insérer dans un même module Excel (ne pas oublier d'ajouter la référence à Microsoft Word xx.x Object Library).
Voici la macro :
Sub copieTableauWordVersExcel()
' Macro adaptée par Mehdi HAMMADI le 31/03/2014
' Objectif : copier chaque tableau d'un document word vers une feuille Excel
' Nécéssite d'activer la référence Microsoft Word xx.x Object Library
' Fait appel à une fonction personnalisée nommée TestOnglet()
' Source du code : http://www.developpez.net/forums/d662968/logiciels/microsoft-office/excel/macros-vba-excel/transfert-d-tableau-word-vers-excel-vba/
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Fichier As String
Dim nbTableaux As Integer
Dim indice As Integer
Dim nomFeuil As String
On Error Resume Next
'Le document Word est supposé fermé avant le lancement de la macro
Fichier = "C:\Users\mehdi.hammadi\Desktop\Test Export Tableaux Word Vers Excel\Data.docx" 'adapter le chemin
Set WordApp = CreateObject("Word.Application") 'creation session Word
WordApp.Visible = True 'pour que word reste masqué pendant l'opération
Set WordDoc = WordApp.Documents.Open(Fichier) 'ouverture du fichier Word
nbTableaux = WordDoc.Tables.Count
For indice = 1 To nbTableaux
WordDoc.Tables(indice).Range.Copy 'copie du tableau Word
nomFeuil = "Feuil" & Trim(Str(indice))
'vérifier si la feuille existe, si non la créer
If TestOnglet(nomFeuil) = False Then
Sheets.Add After:=Sheets(Sheets.Count)
End If
ActiveSheet.Name = nomFeuil ' sélectionner la feuille
Range("A1").Select ' selectionner la cellule A1
ActiveSheet.Paste 'collage des données dans Excel
Next
WordDoc.Close False 'ferme le document Word sans sauvegarde
WordApp.Quit 'ferme l'application Word
End Sub
et voici la fonction :
Function TestOnglet(zz As String) As Boolean
' Test l'existance d'une feuille
' Source : http://vbaforexcel.wordpress.com/tag/verifier-existence-feuille/
On Error Resume Next
TestOnglet = Sheets(zz).Name <> ""
On Error GoTo 0
End Function
Bonne continuation.
Mehdi
En espérant avoir pu rendre service (MehdiH)
Retrouvez moi sur Office Users
