Fonction DO LOOP qui ne fonctionne pas
Bonjour, je suis nouveau sur le forum et je débute la programmation. J'ai fait un code très sommaire (et assez maladroit je pense vu mon niveau) qui devrait me permettre d'aller chercher des cellules dans un classeur préalablement sélectionné par l'utilisateur.
le classeur source est toujours du même format, les onglets et les cellules reste les même, seul le nom et la localisation change (en fonction du mois)
Chaque onglet représente un jour du mois et le nom est le numéro du jour (1,2,3...). Chaque onglet contient 3 tableaux représentant les commentaires de chaque chef d'équipe (3 équipes par jour).
Pour l’analyse j'ai besoin de venir mettre des information les unes à la suite des autres alors je procédé par étape (précisés dans la macro).
Mais voila pour ce faire j'ai besoin de faire appel à une boucle qui va venir extraire les données page par page (de 1 à 31).
Sauf que quand je teste le programme sans la boucle avec un numéro d'onglet au hasard cela fonctionne bien mais quand j'incrémente une variable dans le numéro d'onglet avec la boucle "do loop" , plus rien, le programme se termine mais aucune données.
Je pense que l'erreur ne doit pas être très grosse mais j'ai cherché par tout et pas moyen de trouver d'ou cela vient. (encore désolé pour l'écriture de ce programme je pense que certains experts vont être choqués :aie: )
Voila le programme :
Code:
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
| Sub ChoixFichier()
'déclaration des variables
Dim Fichier As String 'chemin du fichier
Dim shA As Worksheet 'Feuille A
Dim wB As Workbook 'Classeur
Dim lignevide As Integer 'numero 1ere ligne vide
Dim feuille As Integer 'numéro de boucle (attention bien mettre string et non integer)
appel = MsgBox("Cette opération va aboutir à l'extration du rapport Tubing que vous allez selectionner", vbOKCancel + vbInformation, "Attention extration")
If appel = vbOK Then 'demande à l'utilisateur s'il est sur de vouloir poursuivre et l'informe de ce que le programme va executer
lignevide = Empty 'vide la variable qui trouve la premiere ligne vide
feuille = 1 'commence à l'onglet jour 1
Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*") 'Affiche la boîte de dialogue "Ouvrir" et ouvre le fichier selectionné
Application.DisplayAlerts = False 'désactive les boites de dialogue
Set shA = Sheets("data") 'active l'onglet data
Set wB = Workbooks.Open(Filename:=Fichier) 'active le fichier que l'on va extraire
Do 'début de la boucle
'poste 1
Set shA = Sheets("data") 'active l'onglet data
lignevide = Cells(Rows.Count, "a").End(xlUp).Row + 1 'donne le numero de la premiere ligne vide
Set wB = Workbooks.Open(Filename:=Fichier) 'active le fichier que l'on va extraire
shA.Range(("B" & lignevide), ("H" & lignevide + 27)).Value = wB.Sheets(feuille).Range("c41:i68").Value 'copie la plage
wB.Close False ' ferme sans sauve
Set wB = Nothing
Set shA = Nothing
'poste2
Set shA = Sheets("data") 'active l'onglet data
lignevide = Cells(Rows.Count, "a").End(xlUp).Row + 1 'donne le numero de la premiere ligne vide
Set wB = Workbooks.Open(Filename:=Fichier) 'active le fichier que l'on va extraire
shA.Range(("B" & lignevide), ("H" & lignevide + 27)).Value = wB.Sheets(feuille).Range("j41:p68").Value 'copie la plage
wB.Close False ' ferme sans sauve
Set wB = Nothing
Set shA = Nothing
'poste 3
Set shA = Sheets("data") 'active l'onglet data
lignevide = Cells(Rows.Count, "a").End(xlUp).Row + 1 'donne le numero de la premiere ligne vide
Set wB = Workbooks.Open(Filename:=Fichier) 'active le fichier que l'on va extraire
shA.Range(("B" & lignevide), ("H" & lignevide + 27)).Value = wB.Sheets(feuille).Range("q41:w68").Value 'copie la plage
wB.Close False ' ferme sans sauve
Set wB = Nothing
Set shA = Nothing
feuille = feuille + 1 'passage à l'onglet suivant
Loop While feuille = 31 'condition de fin de boucle
Set wB = Nothing
Set shA = Nothing
Application.DisplayAlerts = True 'réactive les boites de dialogue
MsgBox "Términé !" 'message qui confirme la fin de l'execution
End If
End Sub |
