Mise à jour des cellules par rapport à la dernière cellule modifiée

VBA
5

Bonjour

A tester avec le classeur fourni

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x%, Dl%, Nb%, Val%, Lig%
Application.EnableEvents = False 'Déactive les événements
Dl = Range("B" & Rows.Count).End(xlUp).Row 'Dernière ligne colonne B
If Not Application.Intersect(Target, Range("C2:C" & Dl)) Is Nothing Then 'Sur chgt valeur colonne C2 à C et dernière ligne
  Lig = Target.Row 'N° ligne de chgt de valeur
  Val = Target 'Valeur de la cellule changé
  For x = 2 To Dl 'boucle sur la colonne C
    Nb = Cells(x, 2).MergeArea.Count 'Compte le Nb cellule fusionnée
    If Lig > 8 Then GoTo suite1 'Si la ligne est Sup à 8 (fin de A3) je vais à la suite1
        If Cells(x, 2) = "A1" Or Cells(x, 2) = "A2" Or Cells(x, 2) = "A3" Then 'sinon
          Cells(x, 3) = Val 'je place la valeur
        End If
        GoTo suite2 'je vais à suite2
suite1:
        If Cells(x, 2) = "A4" Or Cells(x, 2) = "A5" Or Cells(x, 2) = "A6" Then
          Cells(x, 3) = Val
        End If
suite2:
    x = x + Nb - 1 'ajoute le Nb de cellule à sauter par rapport au Nb cellules fusionnées
  Next x
End If
Application.EnableEvents = True 'Réactive les événements
End Sub

TEST (26).xlsm (17,8 Ko)

2 « J'aime »