Copie de Excel vers Word

Version imprimable

Bonjour à toutes et tous
Excel : LTSC
J’ai un tableau source sur une feuille et une liste déroulante sur une autre pour filtrer mes données.
J’ai créé une macro pour copier les résultats de la liste sur un document Word. Tout fonctionne parfaitement. En revanche, je voudrais que sur le doc Word seules les cellules contenant les données soient copiées. Dans le code que j’ai trouvé il faut indiquer le nombre de lignes et le nombre de colonnes à copier sauf que la liste déroulante change tout le temps donc parfois les cellules du tableau sur Word sont vides.
Y a-t-il un bout de code pour dire à Excel de ne copier que les lignes issues de la liste déroulante.
J’espère être assez clair dans mes explications.

Merci pour votre aide

Voici le code de la macro
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 Sub add_table_2_word() Dim objWord Dim objDoc Dim objSelection Dim i As Integer Dim j As Integer Set objWord = CreateObject("Word.Application") Set objDoc = objWord.Documents.Add Set objSelection = objWord.Selection With objWord objWord.Visible = True objWord.Activate .Selection.TypeText ("EPI METIERS") Set CountryTable = objDoc.Tables.Add(objSelection.Range, 20, 5) With CountryTable With .Borders .Enable = True .OutsideColor = RGB(0, 0, 0) .InsideColor = RGB(0, 0, 0) End With .Rows(1).Shading.BackgroundPatternColor = RGB(51, 204, 51) For i = 1 To 20 For j = 1 To 5 .Cell(i, j).Range.InsertAfter ThisWorkbook.Sheets("Tableau1").Cells(i, j).Text Next j Next i End With End With End Sub

27/09/2024, 11h54
Nain porte koi

Hello,

la macro sans voir les données c'est pas top.
Vous ne pouvez pas mettre le fichier avec des données anonymes histoire qu'on y voie clair
27/09/2024, 14h59
ThieBEN

1 pièce(s) jointe(s)

Oui voici un exemplaire test. Merci pour votre aide

Voici le code corrigé

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
Sub add_table_2_word()
 
    Dim objWord
    Dim objDoc
    Dim objSelection
    Dim i As Integer
    Dim j As Integer
 
    ' *** ajout ***
    Dim Nb_Ligne As Integer
    Nb_Ligne = ThisWorkbook.Sheets("Tableau1").Cells(Rows.Count, 1).End(xlUp).Row
    ' *** ajout ***
 
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    Set objSelection = objWord.Selection
 
    With objWord
 
        .Visible = True
        .Activate
        .Selection.TypeText ("EPI METIERS")
 
        Set CountryTable = objDoc.Tables.Add(objSelection.Range, Nb_Ligne, 5)     ' *** modif ***
 
        With CountryTable
 
            With .Borders
                .Enable = True
                .OutsideColor = RGB(0, 0, 0)
                .InsideColor = RGB(0, 0, 0)
            End With
 
            .Rows(1).Shading.BackgroundPatternColor = RGB(51, 204, 51)
            ' *** ajout ***
            .Rows(1).HeadingFormat = True
            ' *** ajout ***
 
            For i = 1 To Nb_Ligne     ' *** modif ***
 
                For j = 1 To 5
 
                    .Cell(i, j).Range.InsertAfter ThisWorkbook.Sheets("Tableau1").Cells(i, j).Text
 
                Next j
 
            Next i
 
        End With
 
    End With
 
End Sub

27/09/2024, 16h05
ThieBEN

Un grand Merci ça marche Nickel.