Bonjour,
On m'avait envoyer un excellent programme (le terme n'est peut être pas le bon, je suis grand débutant). Depuis, j'ai modifié ma feuille Excel, ce programme ne fonctionne plus ce qui est normal, mais j'aimerai comprendre ce programme pour l'adapter à ma nouvelle feuille Excel. Vous remerciant pour votre aide.
Le programme en question :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A4:C" & Range("A1").CurrentRegion.Count / 15)) Is Nothing Then
If Cells(Target.Row, 1) = "" Or Cells(Target.Row, 2) = "" Or Cells(Target.Row, 3) = "" Then Exit Sub
Application.ScreenUpdating = False
Range(Cells(Target.Row, 4), Cells(Target.Row, 7)).ClearContents
Range(Cells(Target.Row, 9), Cells(Target.Row, 12)).ClearContents
For Each cellule In Sheets(Cells(Target.Row, 1).Text).Range("B3:BF56")
If UCase(cellule.Value) = UCase(Cells(Target.Row, 3).Text) Then
ligne = cellule.Row
colonne = cellule.Column
Cells(Target.Row, 4) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne - 2)
Cells(Target.Row, 5) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne - 2)
Cells(Target.Row, 6) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne - 1)
Cells(Target.Row, 7) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne - 1)
Cells(Target.Row, 9) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne + 1)
Cells(Target.Row, 10) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne + 2)
Cells(Target.Row, 11) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne + 1)
Cells(Target.Row, 12) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne + 2)
Exit Sub
End If
Next cellule
End If
Application.ScreenUpdating = True
End Sub
On m'avait envoyer un excellent programme (le terme n'est peut être pas le bon, je suis grand débutant). Depuis, j'ai modifié ma feuille Excel, ce programme ne fonctionne plus ce qui est normal, mais j'aimerai comprendre ce programme pour l'adapter à ma nouvelle feuille Excel. Vous remerciant pour votre aide.
Le programme en question :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A4:C" & Range("A1").CurrentRegion.Count / 15)) Is Nothing Then
If Cells(Target.Row, 1) = "" Or Cells(Target.Row, 2) = "" Or Cells(Target.Row, 3) = "" Then Exit Sub
Application.ScreenUpdating = False
Range(Cells(Target.Row, 4), Cells(Target.Row, 7)).ClearContents
Range(Cells(Target.Row, 9), Cells(Target.Row, 12)).ClearContents
For Each cellule In Sheets(Cells(Target.Row, 1).Text).Range("B3:BF56")
If UCase(cellule.Value) = UCase(Cells(Target.Row, 3).Text) Then
ligne = cellule.Row
colonne = cellule.Column
Cells(Target.Row, 4) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne - 2)
Cells(Target.Row, 5) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne - 2)
Cells(Target.Row, 6) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne - 1)
Cells(Target.Row, 7) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne - 1)
Cells(Target.Row, 9) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne + 1)
Cells(Target.Row, 10) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne + 7, colonne + 2)
Cells(Target.Row, 11) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne + 1)
Cells(Target.Row, 12) = Sheets(Cells(Target.Row, 1).Text).Cells(ligne, colonne + 2)
Exit Sub
End If
Next cellule
End If
Application.ScreenUpdating = True
End Sub