Copie de Plages séparées avec union( range(...

Bonjour,

Un exemple pour copier la plage de cellule d'Excel vers l'application
Word dans un nouveau document. À toi d'adapter!


'--------------------------------------------------------
Sub test()
'Requiert l'ajoute la la référence :
'"Microsoft Word xx.x Objects Librairy"

Dim Rg As Range, NbColonne As Long
Dim Wd As Word.Application
Dim Dc As Document, C As Column
Dim T As Table, P As Row
Dim A As Integer, B As Integer
Dim Bb As Border, Are As Range
Static Col As Long
Col = 0

'Définir la plage à copier
With Worksheets("EmInfo")
Derligne = .Range("F52").End(xlUp).Row
Set Rg = Union(.Range("A11:B" & Derligne), .Range("F11:H" & Derligne))
End With

'Détermine le nombre de colonnes à copier
'(pour des plages non adjacentes)
For Each Are In Rg.Areas
NbColonne = NbColonne + Are.Columns.Count
Next

'Créer une instance de l'application Word
Set Wd = CreateObject("Word.Application")
Wd.Visible = True
'Ajoute un nouveau document
Set Dc = Wd.Documents.Add

'Ajoute un tableau dans Word
Set T = Dc.Tables.Add(Range:Ü.Range, _
NumRows:=Rg.Rows.Count, _
NumColumns:=NbColonne)

'Copie la plage de cellules vers Word
For Each Are In Rg.Areas
For B = 1 To Are.Columns.Count
Col = Col + 1
For A = 1 To Are.Rows.Count
T.Cell(A, Col).Range = Are(A, B)
Next
Next
Next
Col = 0
'Ajoute les bordures au tableau dans Word si nécessaire
With T
For Each C In .Range.Columns
C.Borders(wdBorderHorizontal).Visible = True
Next
For Each P In .Range.Rows
P.Borders(wdBorderVertical).Visible = True
Next
For A = -4 To -1
.Range.Borders(A) = True
Next
End With

End Sub
'--------------------------------------------------------

Bonjour Denis,

Merci je vais regarder çà.
En fait je serai aussi amené à faire un copié/collé vers un agenda en ligne.

JP