Pb

Bonjour,

Qu'est ce qui cloche ds mon bout de code???


Private Sub Worksheet_Change(ByVal Target As Range)
Dim objFeuille As Worksheet, objPict As Picture
Application.ScreenUpdating = False
opt = Target.Value
adr = Target.Row
Range("F" & adr).Select
On Error Resume Next



If Not (Intersect(Target, Range("K24:K370")) Is Nothing) Then


suite:

Sheets("Feuil1").Select
Select Case opt
Case "Créer"
If Not Intersect(Range(Sheet.TopLeftCell.Address), Range("F" & adr)) Is Nothing Or _
Not Intersect(Range(Sheet.BottomRightCell.Address), Range("F" & adr)) Is Nothing Then
Sheet.Delete
End If
Range("C19").Select
Selection.Copy

Range("F" & adr).Select

ActiveSheet.Paste


Case "Supprimer"
If Not Intersect(Range(Sheet.TopLeftCell.Address), Range("F" & adr)) Is Nothing Or _
Not Intersect(Range(Sheet.BottomRightCell.Address), Range("F" & adr)) Is Nothing Then
Sheet.Delete
End If
Range("C18").Select
Selection.Copy

Range("F" & adr).Select

ActiveSheet.Paste

Case Else
If Not Intersect(Range(Sheet.TopLeftCell.Address), Range("F" & adr)) Is Nothing Or _
Not Intersect(Range(Sheet.BottomRightCell.Address), Range("F" & adr)) Is Nothing Then
Sheet.Delete
End If
Range("C20").Select
Selection.Copy

Range("F" & adr).Select

ActiveSheet.Paste
End Select
On Error GoTo 0
End If



End Sub




la partie:
If Not Intersect(Range(Sheet.TopLeftCell.Address), Range("F" & adr)) Is Nothing Or _
Not Intersect(Range(Sheet.BottomRightCell.Address), Range("F" & adr)) Is Nothing Then
Sheet.Delete
End If

est la pour ne pas supperposé les images, mais ca ne marche pas