Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres Copie dans le presse-papier d'une sélection multiple

Renaud22

XLDnaute Junior
Bonjour à tous,

J'aurais besoin qu'on m'aide à concevoir un code VBA afin de permettre la copie, dans le presse-papier, d'une sélection multiple.

Dans un des fichier ci-joints (Classeur1.xlsm), plusieurs tableaux sont représentés avec différentes valeurs.

Par exemple, pour le tableau 3-5KVA, j'aimerais qu'une macro puisse copier la plage P4-P31 ainsi que la cellule Q35 dans le presse-papier. Une fois la cellule D48 sélectionnée dans l'autre fichier ci-joint (Classeur2.xlsm), et en activant "coller", les valeurs du tableau 3-5KVA seront copiées (colonnes D et E).

Un autre exemple est donné avec le tableau 150-167,5 KVA (Classeur1.xlsm) et les colonnes F et G (Classeur2.xlsm). Je pourrai adapter le code VBA pour tous les tableaux du Classeur1.xlsm. Le nom des classeurs peut varier.

En vous remerciant par avance pour votre précieuse aide.

Salutations,

Renaud22.
 

Pièces jointes

  • Classeur1.xlsm
    26.9 KB · Affichages: 4
  • Classeur2.xlsm
    119.4 KB · Affichages: 3

job75

XLDnaute Barbatruc
Avec une 2ème instance il suffit d'exécuter tout le code à partir du fichier source :

VB:
Dim mem1, mem2 'mémorise les variables

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count <> 2 Then Exit Sub
Dim n, test1 As Boolean, test2 As Boolean
For n = 1 To 2
    If Target.Areas(n).Count = 28 And Target.Columns.Count = 1 Then test1 = True: mem1 = Target.Areas(n)
    If Target.Areas(n).Count = 1 Then test2 = True: mem2 = Target.Areas(n)
Next
If Not test1 And test2 Then mem1 = Empty
Coller 'lance la macro
End Sub

Sub Coller()
Dim a$, xlApp As Object
If IsEmpty(mem1) Then Exit Sub
a = InputBox("Cellule de destination dans Classeur2 :", , "D48")
If a = "" Then Exit Sub
Set xlApp = CreateObject("Excel.Application") 'nouvelle instance
xlApp.Visible = True
With xlApp.Workbooks.Open(ThisWorkbook.Path & "\Classeur2.xlsm").Sheets(1).Range(a)
    .Resize(28) = mem1
    .Cells(32, 2) = mem2
End With
xlApp.ActiveWindow.WindowState = xlMaximized
AppActivate xlApp.Caption
End Sub
 

Pièces jointes

  • Classeur1.xlsm
    35.5 KB · Affichages: 0
  • Classeur2.xlsm
    110.8 KB · Affichages: 0
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…