Appliquer une macro au changement de plusieurs cellules

[LuNat]

[Résolu]Appliquer une macro au changement de plusieurs cellules

Bonjour à tous,

Débutant en VBA, je découvre petit à petit les joies et les galères de la programmation.

Mon problème est le suivant:

Dans un premier tableau, l'utilisateur insère au fur et a mesure plusieurs noms de sites.
Une fois que le nom du site est rentré (au changement de valeur des cellules),
cela me crée un autre tableau sur une feuille différente.

Tout fonctionne correctement tant que je modifie la valeur des cellules de la colonne "site" une par une.

Mais lors d'une copie de plusieurs valeurs "sites" d'un coup (supposons que l'utilisateur fasse un copier/coller d'une précédente base, seule la première valeur site est prise en compte.


Question: Comment faire pour que toute la plage copiée/collée soit prise en compte ?

Ci-joint le code utilisé (je programme avec mes pieds)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Site As Range
Dim y As Integer
Dim x As Integer

Set Site = Range("B6:B65536")


y = (Target.Row - 4) * 4


If Not Application.Intersect(Site, Range(Target.Address)) _
Is Nothing Then

'retranscritpion des données sites de la feuille "sites B" vers la feuille "consommation"

Sheets("Consommation").Range(Sheets("Consommation").Cells(y, 1), Sheets("Consommation").Cells(y + 3, 1)).Merge
Sheets("Consommation").Cells(y, 1).Value = Cells(Target.Row, Target.Column).Value

'Mise en page Conso Base et Conso HC ainsi que le Total Conso pour le site concerné


Sheets("Consommation").Cells(y, 2).Value = "Conso Base"
Sheets("Consommation").Cells(y + 1, 2).Value = "Conso HP"
Sheets("Consommation").Cells(y + 2, 2).Value = "Conso HC"
Sheets("Consommation").Cells(y + 3, 2).Value = "Total Conso"

For x = y To y + 3

Sheets("Consommation Sites Bleu").Cells(x, 3).Value = " kWh "
Next

End If

End Sub

Déjà je pense que Target.Address doit être changé, ou faire une boucle ?
ou changer intégralement le code ?

Bref, j'ai besoin de vos lumières !


Cordialement,

 

[tototiti2008]

Re : Appliquer une macro au changement de plusieurs cellules

Bonjour LuNat,

Bienvenue sur XLD,

Bah, pour du code codé avec les pieds, c'est pas mal du tout

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Site As Range
Dim y As Integer
Dim x As Integer
Dim Cellule As Range
    
    Set Site = Range("B6:B65536")
    
    If Not Application.Intersect(Site, Target) _
    Is Nothing Then
        For Each Cellule In Application.Intersect(Site, Target)
            y = (Cellule.Row - 4) * 4
            'retranscritpion des données sites de la feuille "sites B" vers la feuille "consommation"
            
            Sheets("Consommation").Range(Sheets("Consommation").Cells(y, 1), Sheets("Consommation").Cells(y + 3, 1)).Merge
            Sheets("Consommation").Cells(y, 1).Value = Cellule.Value
            
            'Mise en page Conso Base et Conso HC ainsi que le Total Conso pour le site concerné
            
            
            Sheets("Consommation").Cells(y, 2).Value = "Conso Base"
            Sheets("Consommation").Cells(y + 1, 2).Value = "Conso HP"
            Sheets("Consommation").Cells(y + 2, 2).Value = "Conso HC"
            Sheets("Consommation").Cells(y + 3, 2).Value = "Total Conso"
            
            For x = y To y + 3
                Sheets("Consommation Sites Bleu").Cells(x, 3).Value = " kWh "
            Next
        Next Cellule
    End If
End Sub

 

[LuNat]

Re : Appliquer une macro au changement de plusieurs cellules

Merci beaucoup pour la solution, ça me permet au passage de découvrir que je n'ai pas besoin de taper entièrement Range(Target.Address) mais juste Target ^^

Merci encore et bonne journée !

 

[tototiti2008]

Re : Appliquer une macro au changement de plusieurs cellules

Re,

en effet, Target est un objet Range, comme indiqué là :

Private Sub Worksheet_Change(ByVal Target As Range)

Donc Target dispose de toutes les propriétés et méthodes des Range, comme la propriété Value par exemple