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
| Sub declarermap()
Dim ligndestination As Integer
If Cells(4, 52).Value = "OK" Then
i = 1
feuilledestination = "Données"
feuillesaisie = ActiveSheet.Name
ActiveSheet.Unprotect
Sheets("Données").Unprotect
ligndestination = Cells(2, 52).Value
Cells.Select
Range("F21").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
For col = 50 To 53
For ligne = 2 To 50
Item = Cells(ligne, col - 1).Value
valeur = Cells(ligne, col).Value
If Item <> "" Then
Do Until Sheets(feuilledestination).Cells(5, i).Value = ""
If Sheets(feuilledestination).Cells(5, i).Value = Item Then
Sheets(feuilledestination).Cells(ligndestination, i) = valeur
GoTo H
Else: i = i + 1
End If
Loop
H:
End If
i = 1
Next ligne
Next col
Application.DisplayAlerts = False
Sheets(feuillesaisie).Select
Sheets("vierge").Visible = True
Sheets("vierge").Select
Sheets("vierge").Copy Before:=Sheets(8)
Sheets(feuillesaisie).Select
Sheets(feuillesaisie).Select
Sheets(feuillesaisie).Delete
Sheets("vierge (2)").Select
Sheets("vierge (2)").Name = feuillesaisie
Sheets("vierge").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets(feuillesaisie).Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFiltering:=True, AllowUsingPivotTables:=True
Sheets("Données").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowUsingPivotTables:=True
MsgBox ("Les données ont bien été enregistrées sur la feuille de Données. Vous pouvez dès maintenant sauvegarder le fichier.")
Application.DisplayAlerts = True
Else
MsgBox ("Les données saisies sont erronées. Veuillez vous référer au tableau de contrôle. Les données n'ont pas été enregistrées.")
Application.DisplayAlerts = False
End If
Calculate |
Partager