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
 

Discussions similaires

Réponses
7
Affichages
162
Réponses
3
Affichages
211