Discussion :

[ThieBEN]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[ThieBEN]

Oui voici un exemplaire test. Merci pour votre aide

[Nain porte koi]

Voici le code corrigé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ThieBEN]

Un grand Merci ça marche Nickel.