XL 2016 COPIER COLLER CELLULES SELECTIONNEES PAR CASE COCHEE

gilles42

XLDnaute Nouveau
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.
 

Fichiers joints

job75

XLDnaute Barbatruc
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+
 

Fichiers joints

job75

XLDnaute Barbatruc
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
 

Fichiers joints

gilles42

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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.
 

Discussions similaires


Haut Bas