1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
| Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Dim derLig As Long
Dim lignVide As Long
Dim V1
Dim V2
Dim V3
Dim V4
Dim V5
Dim V6
If Target.Column <> 12 Then Exit Sub
derLig = Range("A" & Rows.Count).End(xlUp).Row
If Target.Row <> derLig Then Exit Sub
If Target.Value = "RM" Then
Set MaPlage = Sheets("GTT").Range("A2:L65000")
For Each Cel In MaPlage
If Cel.Value = "" Then 'si elle est vide alors message à l'utilisateur
MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
'sortie de la procédure
Exit Sub
End If
Next
'il y a 6 valeurs à transférer
V1 = Me.Cells(derLig, 1): V2 = Me.Cells(derLig, 2): V3 = Me.Cells(derLig, 4)
V4 = Me.Cells(derLig, 8): V5 = Me.Cells(derLig, 9): V6 = Me.Cells(derLig, 11)
'Ouvrir la feuill GM
With Worksheets("GM")
Set Cel = .Columns(1).Find(Me.Cells(derLig, 1), , xlValues, xlWhole)
If Cel Is Nothing Then
Sheets("GM").Activate
.Unprotect Password:="XENNA"
'Recherche de la première ligne vide
lignVide = .Range("A" & .Rows.Count).End(xlUp).Row + 1
'Copie des valeurs dans la feuille "GM"
.Cells(lignVide, 1) = V1
.Cells(lignVide, 2) = V3
.Cells(lignVide, 4) = V6
.Cells(lignVide, 5) = V2
.Cells(lignVide, 8) = V4
.Cells(lignVide, 9) = V5
.Protect Password:="XENNA"
Else
MsgBox "Enregistrement déjà existant dans la base de données !"
End If
End With
End If
End Sub |