XL 2013 Incrémenter une liste à partir d'une cellule de référence variable

jbgaillard

XLDnaute Nouveau
Bonjour,

J'aimerais pouvoir recopier une liste de valeurs à partir d'une cellule donnée mais cette cellule peut varier et est choisie par un utilisateur.

Je m'explique : j'ai une liste de valeurs à recopier en colonne P, dans une plage de cellules B2:K12, et l'utilisateur choisi dans cette plage la première cellules pour le recopiage (en mettant "OUI" sur La ligne 1 et colonne1 afin de définir la 1ère cellule, ici D5 dans l'exemple de mon fichier)

Avec un fichier cela sera peut être plus clair (un onglet données d'entrée, et l'onglet résultat que j'aimerais avoir)

Merci infiniment,
 

Pièces jointes

  • Exemple.xlsx
    11.2 KB · Affichages: 15

soan

XLDnaute Barbatruc
Inactif
Bonjour jbgaillard,

bienvenue sur le site XLD ! :)

ouvre le fichier ci-joint, et fais Ctrl e ➯ travail effectué ! 😊

VB:
Option Explicit

Sub Essai()
  If ActiveSheet.Name <> "Données d'entrée" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 16).End(3).Row
  If n = 1 And IsEmpty([P1]) Then Exit Sub
  Dim col%, lig&, i&: Application.ScreenUpdating = 0
  col = 2: Do While Cells(1, col) <> "OUI" And col <= 11: col = col + 1: Loop
  If col = 12 Then Exit Sub
  lig = 2: Do While Cells(lig, 1) <> "OUI" And lig <= 12: lig = lig + 1: Loop
  If lig = 13 Then Exit Sub
  For i = 1 To n
    Cells(lig, col) = Cells(i, 16): lig = lig + 1
    If lig = 13 Then lig = 2: col = col + 1: If col = 12 Then Exit Sub
  Next i
End Sub

soan
 

Pièces jointes

  • Exemple.xlsm
    18 KB · Affichages: 9

soan

XLDnaute Barbatruc
Inactif
Bonsoir Jean-Baptiste,

je te propose une version améliorée du fichier précédent. :)

ouvre le fichier, puis fais Ctrl e ; jusqu'ici, rien de changé, n'est-ce pas ? ;)

c'est maintenant que ça va commencer à être intéressant :



ne change rien sur la feuille, sélectionne H1, saisis "OUI", et valide

➯ en D1, c'est devenu "NON", sans fond jaune ; et en H1 : "OUI" est sur fond jaune



ne change rien sur la feuille, sélectionne A10, saisis "OUI", et valide

➯ en A5, c'est devenu "NON", sans fond jaune ; et en A10 : "OUI" est sur fond jaune



sans rien changer sur la grille, fais Ctrl e

➯ tu as le résultat attendu, sans avoir eu besoin d'effacer les valeurs précédentes

c'est quand même bien plus pratique, pas vrai ? 😊



code VBA de Module1 :

VB:
Option Explicit

Sub Essai()
  If ActiveSheet.Name <> "Données d'entrée" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 16).End(3).Row
  If n = 1 And IsEmpty([P1]) Then Exit Sub
  Dim col%, lig&, i&: Application.ScreenUpdating = 0
  col = 2: Do While Cells(1, col) <> "OUI" And col <= 11: col = col + 1: Loop
  If col = 12 Then Exit Sub
  lig = 2: Do While Cells(lig, 1) <> "OUI" And lig <= 12: lig = lig + 1: Loop
  If lig = 13 Then Exit Sub
  [B2:K12].ClearContents
  For i = 1 To n
    Cells(lig, col) = Cells(i, 16): lig = lig + 1
    If lig = 13 Then lig = 2: col = col + 1: If col = 12 Then Exit Sub
  Next i
End Sub

seule différence par rapport à la sub précédente : ajout de : [B2:K12].ClearContents ; j'avais bêtement oublié l'effacement des valeurs précédentes ; sans ça, il peut y avoir des « interférences » entre les anciens résultats et les nouveaux, et ça t'évite de devoir effacer toi-même manuellement les anciens résultats.​



code VBA du module de Feuil1 :

VB:
Option Explicit

Dim plg As Range

Private Sub Job(cel As Range)
  Application.EnableEvents = 0
  plg.Value = "NON": cel = "OUI"
  Application.EnableEvents = -1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = 0
    Set plg = [A2].Resize(11)
    If Not Intersect(Target, plg) Is Nothing _
      Then If .Value = "OUI" Then Job Target
    Set plg = [B1].Resize(, 10)
    If Not Intersect(Target, plg) Is Nothing _
      Then If .Value = "OUI" Then Job Target
  End With
End Sub



sur la feuille de calcul, la couleur de fond jaune pour un "OUI" en B1:K1 OU en A2:A12 est mise automatiquement, par une seule règle de MFC ; rappel : MFC = Mise en Forme Conditionnelle.​

Image.jpg


soan
 

Pièces jointes

  • Exemple.xlsm
    20.8 KB · Affichages: 4
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo