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
925
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
297
fenec
fenec
S
  • Résolu(e)
XL 2013 Copier-Coller une ligne dans tableau variable, et la manipuler.
Réponses
4
Affichages
248
StéphaneDeLà
S
treza88
  • Question Question
XL 2021 Copier coller qui ajoute une référence absolu Toute seule
2
Réponses
24
Affichages
785
TooFatBoy
TooFatBoy
S
  • Question Question
Microsoft 365 TCD avec pourcentage en fonction d'une variable
Réponses
6
Affichages
203
chris
chris
M
  • Question Question
Autres Problème de sélection
Réponses
14
Affichages
303
fanch55
fanch55
M
  • Question Question
XL 2016 pb création de tableau par macro
Réponses
10
Affichages
213
ChTi160
ChTi160
serras
  • Question Question
XL 2019 Solution OK_problème de débutant (tri)
Réponses
11
Affichages
396
serras
serras
A
  • Question Question
Autres Copier toutes les cellules sauf les cellules vides Vba
Réponses
4
Affichages
91
aminouuu
A
P
  • Résolu(e)
Microsoft 365 Copier coller les mêmes valeurs dans la même cellule
Réponses
12
Affichages
347
job75
job75
A
  • Résolu(e)
XL 2019 Optimisation code VBA (Icônes flottantes)
Réponses
14
Affichages
413
Amilo
A
M
  • Résolu(e)
XL 2021 Copier le texte d’une cellule
Réponses
9
Affichages
267
sylvanu
sylvanu
I
  • Résolu(e)
Microsoft 365 Copier-coller dans une plage avec des cellules masquées
Réponses
6
Affichages
516
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
682
Sellig
Sellig
M
  • Question Question
Microsoft 365 automatiser un bouton "efface cellule"
Réponses
5
Affichages
159
matlatarte
M
P
  • Question Question
Microsoft 365 VBA copier-coller selon conditions
Réponses
4
Affichages
210
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
169
crocrocro
C
BenHarber
  • Question Question
Microsoft 365 Initialisation d'une variable tableau à partir d'une plage de cellules
2
Réponses
17
Affichages
614
job75
job75
M
  • Résolu(e)
Microsoft 365 Erreur 9 macro
Réponses
3
Affichages
204
matmac
M
N
  • Résolu(e)
XL 2019 Macro pour copier ligne avec case à cocher liée
Réponses
12
Affichages
359
Phil69970
Phil69970
Retour