Copier les données d'excel dans word VBA

Résolu/Fermé

mattématt-tique - 15 avril 2010 à 08:24
mattématt-tique - 15 avril 2010 à 11:11

Bonjour,

J'ai un probleme avec le vba d'excel
Je dois faire une macro qui va me copier les données d'un tableau dans un doc word. je peut repérer les cellules intéressantes en repérant le nom de colonne SS1 ou SS2 qu j'ai moi meme attribuer

voila ou j'en suis:

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'""""""""""""""""""""""""""""""""copier les donnés du tableau excel """"""""""""""""""""
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'trouver les données du tableau

Worksheets("Feuil1").Select
Set c = ActiveSheet.UsedRange.Find("*" & "SS1" & "*", , , xlWhole)
If c Is Nothing Then
MsgBox "SS1 introuvable"
Exit Sub
End If

Worksheets("Feuil1").Select
Set d = ActiveSheet.UsedRange.Find("*" & "SS2" & "*", , , xlWhole)
If c Is Nothing Then
MsgBox "SS2 introuvable"
Exit Sub
End If

i = 50

Do While Not (IsEmpty(ActiveSheet.Cells(i, c.Column)))

'prend la valeur de la cellule non vide et l'écrit dans le doc word
S1 = Worksheets("Feuil1").Cells(i, c.Comlumn).Value
S2 = Worksheets("Feuil1").Cells(i, d.Column).Value
objWord.Selection.TypeText Text:=S1 & vbCr & S2
' Passe à la ligne suivante
i = i + 1
Loop

seulement la ligne S1 = Worksheets("Feuil1")...
ne marche pas et je ne comprend pas pourquoi

pourriez vous m'aider s'il vous plait je débute à peine en VBA

A voir également:

Copier les données d'excel dans word VBA
Supprimer une page word - Guide
Liste déroulante excel - Guide
Word excel gratuit - Guide
Espace insécable word - Guide
Organigramme word - Guide

2 réponses

Réponse 1 / 2

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
15 avril 2010 à 10:04

Bonjour,
Essaye quelque chose comme ça :

Dim lig, col1, col2 As Integer
Dim S1, S2 As String
    col1 = Range("SS1").Column
    col2 = Range("SS2").Column
    lig = 50
Do While Not (IsEmpty(ActiveSheet.Cells(lig, col1)))
    S1 = Worksheets("Feuil1").Cells(lig, col1).Value 
    S2 = Worksheets("Feuil1").Cells(lig, col2).Value 
objWord.Selection.TypeText Text:=S1 & vbCr & S2 
lig = lig + 1 
Loop

Tu peux bien entendu tester d'abord si SS1 et SS2 sont bien présents dans la feuille.

Réponse 2 / 2

mattématt-tique
15 avril 2010 à 11:11

merci de ton aide mais finalement j'ai trouvé une autre méthode qui donne un résultat satisfaisant

Dim c As Object
Dim S1 As String
Dim S2 As String
Dim d As Object

'trouver les données du tableau

Worksheets("Feuil1").Select
Set c = ActiveSheet.UsedRange.Find("*" & "SS1" & "*", , , xlWhole)
If c Is Nothing Then
MsgBox "SS1 introuvable"
Exit Sub
End If

Worksheets("Feuil1").Select
Set d = ActiveSheet.UsedRange.Find("*" & "SS2" & "*", , , xlWhole)
If c Is Nothing Then
MsgBox "SS2 introuvable"
Exit Sub
End If

'selectionne les données et les copie
Range(Cells(50, c.Column), Cells(59, d.Column)).Copy

'colle les données et organise la taille des cellules
objWord.Selection.Paste
Docu.Tables(1).AutoFitBehavior wdAutoFitWindow

Application.CutCopyMode = False

Discussions similaires

Dessiner avec son clavier et avec des lettres

Discussions similaires

Newsletters