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 |
Import de tableaux de plusieurs feuilles dans une seule
Répondre avec citation
) mais je "bute" sur un problème de copie.
Envoyé par Jibicas
) et qui "marche":
et je pense que cela peux provenir de:
Partager