XL 2016 VBA macro affectée à une sélection

cardi

XLDnaute Junior
Bonjour,

J'ai créé une macro pour faire les choses suivantes :

- Je sélectionne la colonne B et je la copie dans la colonne A
- Ensuite, dans la colonne B, je retire 1 à toutes les valeurs

Actuellement, cela me fait ce principe sur les lignes 9 à 100.

J'aimerai modifier mon code pour que cela s'applique seulement aux cellules sélectionnées. Par exemple, je sélectionne les cellules B9 à B50, je lance la macro, mon code fonctionne seulement pour les lignes jusqu'à 50.

Voici mon code initial :

VB:
Sub baisser1()

    Columns("B:B").Select
    Selection.Copy
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B9").Select
    Application.CutCopyMode = False
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-1"
    Range("B9").Select
    Selection.AutoFill Destination:=Range("B9:B100"), Type:=xlFillDefault

End Sub
Merci d'avance,

CARDI
 

Ikito

XLDnaute Occasionnel
Bonjour cardi,

Sélectionne la zone que tu souhaites et lance la macro suivante :

VB:
Sub baisser1()

    NbBoucle = Selection.Rows.Count
    LettreLigne = Selection
    
    Range("A:A").ClearContents
    
    For i = 1 To NbBoucle
        Cells(i, "A") = LettreLigne(i, 1) - 1
    Next
    
End Sub
 

cardi

XLDnaute Junior
bonjour,

Cela fonctionne en partie.

Quand j'execute votre macro, si je fais la sélection par exemple B5:B9, cela va mettre les valeurs "B - 1" dans la cellule A1, A2, A3, A4 et A5.

Ce que je souhaite :

Remplacer les valeurs de B5 à B9 dans les memes cellules en retirant 1 dans chaque cellule

Merci d'avance
 

Ikito

XLDnaute Occasionnel
Bonjour Cardi,

Dans ce cas il faut préciser dès le début :)

Les ajustements ci-dessous :

VB:
Sub baisser1()

    NbBoucle = Selection.Rows.Count
    LettreLigne = Selection
    LigneDeb = Selection.Row
    
    Range("A:A").ClearContents
    
    For i = LigneDeb To LigneDeb + NbBoucle - 1
        Cells(i, "A") = LettreLigne(i - LigneDeb + 1, 1) - 1
    Next
    
End Sub
 

Dranreb

XLDnaute Barbatruc
Bonjour.
VB:
Option Explicit

Sub Baisser1()
   Dim Rng As Range
   Set Rng = Selection
   Rng.Offset(, -1).Value = Rng.Value
   Rng.FormulaR1C1 = "=RC[-1]-1"
   End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas