Etendre ActiveCell à une sélection multiple

barbenault

XLDnaute Nouveau
Bonjour à tous,

J'espère pouvoir trouver sur ce forum des réponses à mes questions. Je vous remercie par avance pour le temps que vous me consacrerez.

Je dispose d'une macro très simple dont le but est de copier / coller une formule d'une plage aux coordonnées fixes vers une plage définie par l'utilisateur (identifier grâce à Active cell).

Pour améliorer ma macro, j'aimerais que cette macro ne s'applique pas seulement à la cellule active mais à une sélection d'une à plusieurs celulles.

Voici mon code :
Code:
Sub Auto_forecast()

Dim L As Long, R As Range
L = ActiveCell.Row

Application.ScreenUpdating = False
 
ActiveSheet.Unprotect Password:=MDP
  
For Each R In Range("N10,Q10,T10,W10,Z10,AC10,AF10,AI10,AL10,AO10,AR10,AU10")
R.Copy Cells(L, R.Column)
  
Next
ActiveSheet.Protect UserInterfaceOnly:=True, Password:=MDP, DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, _
AllowFormattingRows:=False

Calculate
Application.ScreenUpdating = True

End Sub
 

barbenault

XLDnaute Nouveau
Re : Etendre ActiveCell à une sélection multiple

Bonjour Gosselien,

J'ai reproduit mon fichier dans un nouveau classeur. Le voici en pièce jointe.

Tu verras que si l'on se positionne sur une ligne (ligne 9 par exemple), la macro s'applique. J'aimerais pouvoir faire fonctionner la macro en boucle sur l'ensemble des lignes que sélectionnerait l'utilisateur, or si je sélectionne les lignes 9 et 10, la macro ne s'applique que sur la ligne 9.

Il y a une contrainte (identifiée en colonne B), si il y a une "x", la macro s'arrête. J'aimerais que la commande s'applique sur chaque ligne sélectionnée en intégrant cette contrainte (si "x", tu appliques le code, si pas de "x", tu passes à la ligne suivante... etc jusqu'à la dernière ligne sélectionnée).

Mon fichier original est un prévisionnel de dépenses automatisé, les chiffres de ma colonne C correspondent à des calculs de moyenne. Donc à ce jour, la macro fonctionne mais l'utilisateur doit faire la manipulation ligne à ligne, ce qui est un peu fastidieux. Pas certain que cette explication t'éclaire beaucoup. J'espère que le fichier est assez parlant.

Merci encore de te pencher sur mon problème.
 

Pièces jointes

  • Test.xlsm
    16.8 KB · Affichages: 21
  • Test.xlsm
    16.8 KB · Affichages: 29
  • Test.xlsm
    16.8 KB · Affichages: 33

gosselien

XLDnaute Barbatruc
Re : Etendre ActiveCell à une sélection multiple

re,

pas compris en effet , mais je suis parfois dur de la comprenette...
on fait quoi avec les lignes "X" ?
on les copie ? où ?
toutes ?
une à la fois ?
il y aura des formules dedans avant déplacement / copie ?

pourquoi si c'est une copie, filtrer (menu données/filtre) les lignes "X" et puis les copier ?
 

barbenault

XLDnaute Nouveau
Re : Etendre ActiveCell à une sélection multiple

En fait, si tu lances la macro, ce sont les formules contenues dans les cellules D7, F7, H7, J7 et L7 qui sont copiées vers les cellules DY, FY, HY, JY et LY (où Y correspond au numéro de la ligne active).

Le "X" contenu dans la colonne B est simplement là pour autoriser ou interdire la lancement de la macro. Tous les lignes qui ne contiennent pas "X" ne doivent pas être remplacées.
Code:
If Cells(L, 2) <> "x" Then Exit Sub
... où L correspond à la ligne active.

Donc, on copie toujours les cellules D7, F7, H7, J7 et L7, vers DY, FY, HY, JY et LY.

Cependant j'aimerais que l'utilisateur sélectionne les lignes 9 à 11 (disons qu'il sélectionne (C9 : C11) et que la macro (lancée via le bouton) vienne copier les formules de la plage de référence (D7, F7, H7, J7 et L7) vers D9, F9, H9, J9 et L9, puis D10, F10, H10, J10 et L10, puis D11, F11, H11, J11 et L11.

La contrainte c'est de limiter cette macro aux lignes 9 et 11.


Si l'on veut compliquer, on ajoute cette petite "x" en début de ligne pour indiquer d'appliquer la macro ou non si "x" ou pas "x". Mais déjà si tu trouves la solution à mon premier problème, ce sera déjà bien.

Merci
 
Dernière édition:

barbenault

XLDnaute Nouveau
Re : Etendre ActiveCell à une sélection multiple

Bonjour,

Commencez pas lire toutes les pistes qui vous sont proposées sur l'autre forum.

Voici la solution proposée par PMO2 sur un autre forum :

Code:
Sub Macro()
Dim Plage As Range
Dim C As Range
Dim L As Long
Dim R As Range
'---
If TypeName(Selection) <> "Range" Then Exit Sub
Set Plage = Selection
Application.ScreenUpdating = False
'---
For Each C In Plage
  L = C.Row
  If Cells(L, 2) = "x" Then
    For Each R In Range("D7,F7,H7,J7,L7")
      R.Copy Cells(L, R.Column)
    Next R
  End If
Next C
'---
Calculate
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Réponses
3
Affichages
848

Statistiques des forums

Discussions
312 499
Messages
2 088 999
Membres
104 002
dernier inscrit
SkrauzTTV