XL 2016 COPIER COLLER CELLULES SELECTIONNEES PAR CASE COCHEE

gilles42 · 20 Septembre 2019

Bonjour à toutes et à tous.
J'ai un classeur avec deux feuilles : activite et bdd. J'aimerais qu'en inscrivant "X" (ou juste un clic de souris), dans la case S5, S6, S7 etc.... celà me sélectionne les cellules C5 à F5, C6 à F6, C7 à F7 etc..... de la feuille "activité" pour venir les coller dans mon tableau "bdd". J'aimerais aussi qu'en A:A de "bdd", il y ait un point (.) si la valeur est inférieure ou égale à 0.
Enfin si celà est possible, j'aimerais que mes nouvelles données se classent automatiquement par societe.
Je vous joins une ébauche de mon fichier.
Merci par avance pour votre aide.

job75 · 21 Septembre 2019

Bonjour gilles42,

Votre fichier était vérolé, je l'ai refait, voyez ci-joint.

Pas besoin de "x", un double-clic sur la ligne à transférer suffit.

Voyez cette macro dans le code de la feuille "Activité" (clic droit sur l'onglet et Visualiser le code) :

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Then Exit Sub
Cancel = True
With Sheets("BDD")
    With .Range("A" & .Rows.Count).End(xlUp)(2)
        .Resize(, 4) = Intersect(Target.EntireRow, [C:F]).Value 'copie uniquement les valeurs
        If .Value <= 0 Then .Value = "."
    End With
    .[A1].CurrentRegion.Sort .[B1], xlAscending, Header:=xlYes 'tri sur les sociétés
    .Activate 'facultatif
End With
End Sub

Si vous faites plusieurs fois un double-clic sur la même ligne il y aura bien sûr des doublons... Mais c'est une autre histoire !!!

A+

job75 · 21 Septembre 2019

Si l'on veut que le résultat soit en majuscules il suffit d'ajouter une boucle, fichier(2) :

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Then Exit Sub
Dim c As Range
Cancel = True
With Sheets("BDD")
    With .Range("A" & .Rows.Count).End(xlUp)(2)
        .Resize(, 4) = Intersect(Target.EntireRow, [C:F]).Value 'copie uniquement les valeurs
        If .Value <= 0 Then .Value = "."
        For Each c In .Resize(, 4): c = UCase(c): Next 'majuscules
    End With
    .[A1].CurrentRegion.Sort .[B1], xlAscending, Header:=xlYes 'tri sur les sociétés
    .Activate 'facultatif
End With
End Sub

gilles42 · 22 Septembre 2019

bonjour JOB75
Vos formules fonctionnent parfaitement bien.
Pouvez vous me dire comment faire pour restreindre ce double-clic au tableau ? Car lorsque je double clic en dehors des limites, la feuille "BDD" s'ouvre.
encore merci pour tout.

job75 · 22 Septembre 2019

gilles42 à dit:
Pouvez vous me dire comment faire pour restreindre ce double-clic au tableau ?

Vous pouvez remplacer If Target.Row < 5 Then Exit Sub par :

VB:

If Intersect(Target, [C5:F30,C36:F61]) Is Nothing Then Exit Sub

Mais on peut aussi ne rien limiter : l'utilisateur doit savoir ce qu'il fait non ?

job75 · 22 Septembre 2019

Finalement ceci n'est pas mal pour limiter :

VB:

If Not IsDate(Cells(Target.Row, 2).Text) Or Intersect(Target, [C:F]) Is Nothing Then Exit Sub

Le transfert n'a lieu que s'il y a une heure entrée en colonne B.

XL 2016 COPIER COLLER CELLULES SELECTIONNEES PAR CASE COCHEE

gilles42

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

gilles42

XLDnaute Nouveau

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires