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

Le
JP
Bonjour,

J'utilise ce code pour copier deux plages séparées.

Sub CopiePlage2()

Derligne = Sheets("EmInfo").Range("F52").End(xlUp).Row

Union(Range("A11:B" & Derligne), Range("F11:H" & Derligne)).Copy

End Sub

Le problème c'est que lorsque je fais un CTRL+V dans word ( word par exem=
ple) j'ai aussi les colonnes C;D et E qui apparaissent.

Est-ce qu'il existe un autre moyen de le faire (en une seule fois)?

Merci

JP
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #26178652
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
'--------------------------------------------------------
JP
Le #26178722
Bonjour Denis,

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

JP
Publicité
Poster une réponse
Anonyme