Discussion :

[hakuna_du_94]

J'ai un souci, je démarre dans la programmation vba, et bien entendu je suis une quiche !

Voilà le problème. J'ai 200 quizz à traiter (quizz aaaa, quizz bbbb, quizz cccc, etc). Ils sont répartis dans différents répertoires (service 1, service 2, service 3, etc) eux-mêmes contenus dans le répertoire MonDossier. Les cellules dont j'ai besoin sont placées au même endroit dans chaque quizz (encore heureux sinon on n'était pas dans la m... !).

Le but du jeu est d'aller «*scanner*» les répertoires pour scanner chacun des quizz, prendre les infos dont j'ai besoin pour les copier dans ma feuille Réponses, toutes les 3 lignes si possible. Et sans ouvrir les 200 quizz bien entendu, car je crois au Père Noël.

Ca donnerait quelque chose comme ça, en français :

Boucler tant que MonDossier est non vide ' « vide » n'est peut-être pas le mot qui convient ici

'scan du répertoire Service 1

Compter le nbre de quizz
Pour I =0 jusqu'à nbre de quizz

'scan du 1er quizz

copier cellule A18 du quizz dans cellule A1 de la feuille Réponses
copier cellule A20 du quizz dans cellule B1 de la feuille Réponses
copier cellule A25 du quizz dans cellule C1 de la feuille Réponses
copier cellule A27 du quizz dans cellule D1 de la feuille Réponses
copier cellule A29 du quizz dans cellule E1 de la feuille Réponses
copier cellule A33 du quizz dans cellule F1 de la feuille Réponses
copier cellule A35 du quizz dans cellule G1 de la feuille Réponses

'les cellules à recopier ne se suivent pas, mais elles sont recopiées dans des
'cellules contigües.
ligne=ligne +3

'scan du 2e quizz

copier cellule A18 du quizz dans cellule A4 de la feuille Réponses
copier cellule A20 du quizz dans cellule B4 de la feuille Réponses
copier cellule A25 du quizz dans cellule C4 de la feuille Réponses
copier cellule A27 du quizz dans cellule D4 de la feuille Réponses
copier cellule A29 du quizz dans cellule E4 de la feuille Réponses
copier cellule A33 du quizz dans cellule F4 de la feuille Réponses
copier cellule A35 du quizz dans cellule G4 de la feuille Réponses


Fin de la boucle

'le répertoire MonDossier contient un autre répertoire
'scan du répertoire Service 2

'reprendre du début jusqu'à ce que :
Fin de la boucle car tous les fichiers de tous les répertoires de MonDossier ont été lus.

Pour info, j'ai essayé de m'aider de ce code que j'ai trouvé sur un forum :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub rapatriement()
	Dim ReponsesOG As String, Ligne As Long
	Const Chemin = "D:\ABC\essai\"
	Ligne = 3
ReponsesOG = Dir(Chemin & "\*.xl*")
Do While ReponsesOG <> ""
Workbooks.Open Filename:=Chemin & ReponsesOG
Sheets("Feuil1").Select
Range("A1:J2").Copy
 
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1).PasteSpecial _
xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
 
Ligne = Ligne + 9
Workbooks(ReponsesOG).Close False
ReponsesOG = Dir
Loop
End Sub

Mais ça ne marche pas et j'ai du mal à m'y retrouver là-dedans ! Voilà, vous voyez mieux ce sur quoi je bute ? Ce programme doit tourner sur excel 2003, au cas où ça serait important.....

Pliz, aidez-moiiiii !

[oOVaveOo]

Bonjour,
Tu as déjà un problème avec le chemin du fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks.Open Filename:=Chemin & "\" & reponsesog

[JackOuYA]

Bonjour,
Tu as déjà un problème avec le chemin du fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks.Open Filename:=Chemin & "\" & reponsesog

chemin contient déjà le "\" ...



par contre ce code ne fait pas du tout ce que tu décris ..! , il ouvre les classeurs 1 à 1..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub rapatriement()
	Dim ReponsesOG As String, Ligne As Long
	Const Chemin = "D:\ABC\essai\"
Ligne = 1 '1° ligne
Dim yaWk as workbook
ReponsesOG = Dir(Chemin & "\*.xl*")
Do While ReponsesOG <> ""
set yaWk = Workbooks.Open (Chemin & ReponsesOG=
'copier cellule A18 du quizz dans cellule A1 de la feuille Réponses
ThisWorbook.Sheets("Reponses").cells(Ligne,1)= yaWk.sheets(1).Range("A18") 
'A copier pour autres valeurs... 
Ligne = Ligne + 3
yaWk.Close False
ReponsesOG = Dir
Loop
...

[oOVaveOo]

chemin contient déjà le "\" ...

Exact, j'avais pas vu

Il faudrait dire où ça coince.

[DarkVader]

.../...
Le but du jeu est d'aller «*scanner*» les répertoires pour scanner chacun des quizz, prendre les infos dont j'ai besoin pour les copier dans ma feuille Réponses, toutes les 3 lignes si possible. Et sans ouvrir les 200 quizz bien entendu, car je crois au Père Noël.
.../...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub rapatriement()
	Dim ReponsesOG As String, Ligne As Long
	Const Chemin = "D:\ABC\essai\"
	Ligne = 3
ReponsesOG = Dir(Chemin & "\*.xl*")
Do While ReponsesOG <> ""
Workbooks.Open Filename:=Chemin & ReponsesOG
.../...

Faudrait savoir ce que tu veux
Sinon comme toujours, il suffit de lire les tutos ...