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
|
Sub Transfert()
Dim Lig As Long
Dim Region_Col As Integer
Dim Region_lign As Integer
Dim Nom As String, Region As String, Numero As String
Dim c As Range
Application.ScreenUpdating = False
With Sheets("Liste dpt")
'Données d'entrée dans B1:B3
Nom = .Range("B1").Value
Region = .Range("B2").Value
Numero = .Range("B3").Value
'Vérification
MsgBox "Nom : " & Nom & vbCrLf & "Région : " & Region & vbCrLf & "Numéro : " & Numero
'Si Region renseignée est non vide
If Region <> "" Then
'Recherche dans la ligne 10 la région en question: c est les cellule de la ligne 10 contenant Region
Set c = .Rows(10).Find(Region, lookat:=xlWhole)
'Si la région est trouvée (c'est à dire la variable c est non vide)
If Not c Is Nothing Then
'La colonne de la région, c'est la colonne de la cellule trouvé c
Region_Col = c.Column
Region_lign = d.Column
'On vide la variable c, on n'en aura plus besoin
Set c = Nothing
Set d = Nothing
'La ligne de la première cellule vide en montant du bas de la colonne trouvée
Lig = .Cells(.Rows.Count, Region_Col).End(xlUp).Row + 1
'On insère les données dans les cellules corespondantes
.Cells(Lig, Region_Col) = Nom
.Cells(Lig, Region_Col + 1) = Numero
.Cells(Lig, Region_lign) = Nom
.Cells(Lig, Region_lign + 1) = Numero
'On efface la plage d'entrée
.Range("B1:B3").ClearContents
'Si la région est non trouvée
Else
MsgBox "ATTENTION la région : " & Region & " n'existe pas dans le tableau"
End If
End If
End With
End Sub |