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 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
|
Option Explicit
Public Sub importer()
Dim compteur As Integer, x As Integer
Dim i As Long, j As Long, k As Long, l As Long
Dim Col As Byte
Dim Correct As Boolean
Dim FL1 As Worksheet, FL2 As Worksheet
Set FL1 = Worksheets("Recap")
Correct = False
Col = 5 'numéro de la colonne où son pris les noms
j = 0
k = 0
l = 0
'Je crée une boucle compteur sur l'ensemble de mon tableau qui le parcourera en recherchant le nombre de cellules "vides" et "pleines".
For compteur = 4 To 11 'FL1.Cells(3, Col).End(xlDown).Row 'retiré car ne me permet pas de "blinder" la macro...a savoir permettre le calcul sans faire bugger la macro malgrès des erreurs de remplissage.
If Cells(compteur, Col).Text <> "" Then
k = k + 1
Else
l = l + 1
End If
Next compteur
'Ici, la boucle va me permettre de remplir mon tableau récapitulatif en évitant les bugs d'écriture dans le tableau
For i = 4 To 11
If k = 8 Then 'valeurs de (11-4..."+1") on compte en incluant la ligne 4
For x = 1 To Sheets.Count 'Là, je vais chercher à comparer chacune des valeurs écrites par l'utilisateur à chacun des noms des onglets existant.
If Sheets(x).Name = Cells(i, Col).Text Then
Correct = True
Exit For
Else
Correct = False
End If
Next x
If Correct = False Then
MsgBox ("Il y a une erreur d'orthographe dans le nom de la feuille: " & Cells(i, Col).Text & ", dont vous souhaitez importer les valeurs")
j = j - 1
k = k - 1
Else
Set FL2 = Worksheets(Cells(i, Col).Text)
FL2.Range("B2:B7").Copy
FL1.Cells(5, i + 3 + j).PasteSpecial Paste:=xlValues
j = j + 1
k = k - 1
End If
Else
If l = 8 Then
MsgBox ("Merci de remplir le tableau avant d'importer.")
Exit Sub
Else
'Là, je vais chercher aussi à comparer chacune des valeurs écrites par l'utilisateur à chacun des noms des onglets existant.
If Cells(i, Col).Text <> "" Then
For x = 1 To Sheets.Count
If Sheets(x).Name = Cells(i, Col).Text Then
Correct = True
Exit For
Else
Correct = False
End If
Next x
If Correct = False Then
MsgBox ("Il y a une erreur d'orthographe dans le nom de la feuille: " & Cells(i, Col).Text & ", dont vous souhaitez importer les valeurs")
j = j - 1
k = k - 1
Else
Set FL2 = Worksheets(Cells(i, Col).Text)
FL2.Range("B2:B7").Copy
FL1.Cells(5, i + 3 + j).PasteSpecial Paste:=xlValues
j = j + 1
k = k - 1
End If
Else
If Cells(i, Col).Text = "Recap" Then
MsgBox ("Vous ne pouvez importer la fiche récapitulative.")
j = j - 1
Else
If (Cells(i, Col).Text = "" And k = 0) Then
Exit Sub
Else
If Cells(i, Col).Text = "" Then
MsgBox ("Merci de remplir le tableau d'import sans laisser de cellules vides.")
j = j - 1
Else
End If
End If
End If
End If
End If
End If
Next i
End Sub |
Partager