Macro pour copier/coller une sélection variable de cellules...

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Trier par date Trier par votes
Bonjour Christian,

Le code de la feuille "LesCA" :
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count > 1 Or Target.Row > 1 Or Target.Column = 1 Or Target.Rows.Count <> 5 Or Target(1) = "" Then Exit Sub
With Feuil3.Range("D" & Feuil3.Rows.Count).End(xlUp)(2, 2).Resize(5, Target.Columns.Count)
  Target.Copy .Cells
  .Cells = .Cells.Value 'supprime les formules
  .Cells(5, 1).Copy .Cells(5, 0) 'pour copier les formats
  .Cells(5, 0) = "=IF(RC[1]="""","""",SUM(" & .Rows(5).Address(0, 0, xlR1C1, , .Cells(5, 0)) & "))"
  .Cells(5, 0).Borders.Weight = xlThin
  .Borders(xlEdgeLeft).Weight = xlThin 'c'est mieux
  .Borders(xlEdgeRight).Weight = xlThin 'c'est mieux
  .Parent.Activate 'facultatif
End With
End Sub
Pour commencer à tester supprimer d'abord tout ce qui est sous la ligne 9 de la feuille "RécapCA".

Nota : pas trop compris l'intérêt du test SI(E14="";""; dans la formule en D14...

A+
 
Vote positif 0 Vote négatif
Re, le forum,
Bonjour à tous,

Je reviens vers vous, pour le code que m'a concocté job75.
Serait-il possible que lors de la sélection des CA, dans la feuille "LesCA", la zone ainsi sélectionnée soit encadrée d'une bordure rouge.
Ces encadrements permettraient de bien visualiser les CA déjà sélectionnés et un contrôle de cohérence des sélections ainsi effectuées.

Merci pour votre aide.
Bien à vous,
Christian
 
Vote positif 0 Vote négatif
Bonsoir Christian,

Bon, mais ça pollue grave le tableau source :
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count > 1 Or Target.Row > 1 Or Target.Column = 1 Or Target.Rows.Count <> 5 Or Target(1) = "" Then Exit Sub
Dim i As Byte
With Feuil3.Range("D" & Feuil3.Rows.Count).End(xlUp)(2, 2).Resize(5, Target.Columns.Count)
  Target.Copy .Cells
  .Cells = .Cells.Value 'supprime les formules
  .Cells(5, 1).Copy .Cells(5, 0) 'pour copier les formats
  .Cells(5, 0) = "=IF(RC[1]="""","""",SUM(" & .Rows(5).Address(0, 0, xlR1C1, , .Cells(5, 0)) & "))"
  .Cells(5, 0).Borders.Weight = xlThin
  .Borders(7).Weight = xlThin 'c'est mieux
  .Borders(10).Weight = xlThin 'c'est mieux
  .Parent.Activate 'facultatif
End With
For i = 7 To 10
  Target.Borders(i).Weight = xlThick
  Target.Borders(i).Color = vbRed
Next
End Sub
Bonne fin de soirée.

Edit : petite erreur (mais VBA n'est pas logique), c'est .Borders(10) qu'il faut écrire.
 
Dernière édition:
Vote positif 0 Vote négatif
Re,

Il vaut mieux ceci, c'est plus facile à effacer ensuite :
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count > 1 Or Target.Row > 1 Or Target.Column = 1 Or Target.Rows.Count <> 5 Or Target(1) = "" Then Exit Sub
With Feuil3.Range("D" & Feuil3.Rows.Count).End(xlUp)(2, 2).Resize(5, Target.Columns.Count)
  Target.Copy .Cells
  .Cells = .Cells.Value 'supprime les formules
  .Cells(5, 1).Copy .Cells(5, 0) 'pour copier les formats
  .Cells(5, 0) = "=IF(RC[1]="""","""",SUM(" & .Rows(5).Address(0, 0, xlR1C1, , .Cells(5, 0)) & "))"
  .Cells(5, 0).Borders.Weight = xlThin
  .Borders(7).Weight = xlThin 'c'est mieux
  .Borders(10).Weight = xlThin 'c'est mieux
  .Parent.Activate 'facultatif
End With
Target.Interior.ColorIndex = 15 'gris
End Sub
Edit : petite erreur (mais VBA n'est pas logique), c'est .Borders(10) qu'il faut écrire.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Bonjour Christian,

J'ai complété ton fichier, j'espère que ça t'intéressera.

Le code de la feuille "RécapCA" :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Feuil2.Worksheet_BeforeDoubleClick Feuil2.[A5], False 'lance la macro (qui n'est pas Private)
End Sub
Le code modifié de la feuille "LesCA" :
Code: 
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'n'est plus Private...
If Target.Address <> "$A$5" Then Exit Sub
Cancel = True: _
Application.ScreenUpdating = False
Feuil3.UsedRange.Name = "RécapCA" 'nom défini dans le classeur
With [B5].Resize(2, Cells(2, Columns.Count).End(xlToLeft).Column)
  .Rows(1) = "=IF(COUNTA(B3:B4),COUNTA(B3:B4)/2,"""")" 'ligne 5
  .Rows(2) = "=1/COUNTIF(RécapCA,B2)" 'ligne 6 (auxiliaire)
  With .Rows(-3).Resize(5) 'lignes 1:5
    .Interior.ColorIndex = xlNone 'effacement des couleurs de fond
    On Error Resume Next 's'il n'y a pas de dates en Feuil3
    Intersect(.Cells, .Rows(6).SpecialCells(xlCellTypeFormulas, 1).EntireColumn).Interior.Color = 14540253 'gris clair
    .Rows(6) = "" 'RAZ ligne 6
  End With
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count > 1 Or Target.Row > 1 Or Target.Column = 1 Or Target.Rows.Count <> 5 Or Target(1) = "" Then Exit Sub
Application.EnableEvents = False 'évite de lancer la Worksheet_Change et la Worksheet_BeforeDoubleClick
With Feuil3.Range("D" & Feuil3.Rows.Count).End(xlUp)(2, 2).Resize(5, Target.Columns.Count)
  Target.Copy .Cells
  .Cells = .Cells.Value 'supprime les formules
  .Cells(5, 1).Copy .Cells(5, 0) 'pour copier les formats
  .Cells(5, 0) = "=IF(RC[1]="""","""",SUM(" & .Rows(5).Address(0, 0, xlR1C1, , .Cells(5, 0)) & "))"
  .Cells(5, 0).Borders.Weight = xlThin
  .Borders(xlEdgeLeft).Weight = xlThin 'c'est mieux
  .Borders(xlEdgeRight).Weight = xlThin 'c'est mieux
  .Parent.Activate 'facultatif
End With
Target.Interior.Color = 14540253 'gris clair
Application.EnableEvents = True
End Sub
Fichier joint.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

K
  • Question Question
XL 2016 VBA: Selection Date renvoie copier/coller
Réponses
8
Affichages
863
Krome36
K
fenec
  • Résolu(e)
Autres Copier/ Coller plage de données dans une autre cellule d'un même onglet
Réponses
6
Affichages
229
fenec
fenec
S
  • Résolu(e)
XL 2013 Copier-Coller une ligne dans tableau variable, et la manipuler.
Réponses
4
Affichages
175
StéphaneDeLà
S
M
  • Question Question
Autres Problème de sélection
Réponses
14
Affichages
249
fanch55
fanch55
M
  • Question Question
XL 2016 pb création de tableau par macro
Réponses
10
Affichages
126
ChTi160
ChTi160
serras
  • Question Question
XL 2019 Solution OK_problème de débutant (tri)
Réponses
11
Affichages
381
serras
serras
A
  • Question Question
Autres Copier toutes les cellules sauf les cellules vides Vba
Réponses
4
Affichages
81
aminouuu
A
P
  • Résolu(e)
Microsoft 365 Copier coller les mêmes valeurs dans la même cellule
Réponses
12
Affichages
334
job75
job75
A
  • Résolu(e)
XL 2019 Optimisation code VBA (Icônes flottantes)
Réponses
14
Affichages
364
Amilo
A
I
  • Résolu(e)
Microsoft 365 Copier-coller dans une plage avec des cellules masquées
Réponses
6
Affichages
406
sylvanu
sylvanu
Sellig
  • Résolu(e)
XL 2019 Sélection zone avec la souris et copier puis Sélection zone avec la souris et coller
Réponses
9
Affichages
639
Sellig
Sellig
M
  • Question Question
Microsoft 365 automatiser un bouton "efface cellule"
Réponses
5
Affichages
134
matlatarte
M
P
  • Question Question
Microsoft 365 VBA copier-coller selon conditions
Réponses
4
Affichages
151
vgendron
vgendron
C
  • Résolu(e)
XL 2016 Propriété pour déterminer si la sélection correspond à une plage de cellules
Réponses
2
Affichages
138
crocrocro
C
BenHarber
  • Question Question
Microsoft 365 Initialisation d'une variable tableau à partir d'une plage de cellules
2
Réponses
17
Affichages
557
job75
job75
M
  • Résolu(e)
Microsoft 365 Erreur 9 macro
Réponses
3
Affichages
190
matmac
M
N
  • Résolu(e)
XL 2019 Macro pour copier ligne avec case à cocher liée
Réponses
12
Affichages
272
Phil69970
Phil69970
BenHarber
  • Question Question
Microsoft 365 Filtrer dans une variable-tableau : possible ?
4 5 6
Réponses
79
Affichages
1 K
BenHarber
BenHarber
A
  • Question Question
Déplacer données en vba
Réponses
3
Affichages
386
akm
A
R
  • Question Question
XL 2010 Copie de plusieurs plages de cellules spécifiques dans le presse-papier
2
Réponses
20
Affichages
463
Dranreb
Dranreb
Retour