Traiter Questionnaire

[gerson94]

Bonsoir les xldnautes,
J'ai crée une macro qui me permet d'importer des données du fichier question vers un fichier synthèse. Tout fonctionne bien tant que les 2 fichiers sont ouverts.
Comme je vais traiter 300 fichiers "questions" j'aimerais que ma macro améliorée puisse ouvrir chaque fichier "question" (question1, question2...question300 ) et la fermer après en avoir recopié le contenu.
Merci de votre aide

Ma macro ci-dessous :

Sub copier
'
    ThisWorkbook.Activate
    Sheets("Feuil1").Select
    
    nbl = Range("E9").CurrentRegion.Rows.Count
    Range("E9:E" & nbl).ClearContents
    
    NomExtract = InputBox("Nom du Fichier : ", "question", "question")
    Workbooks(NomExtract & ".xls").Activate
    Range("E9:E48").Select
    Selection.Copy
    ThisWorkbook.Activate
    Range("E9:E48").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    
     Range("A3").Select
          
End Sub

Gerson

 

[Habitude]

Re : Traiter Questionnaire

Je te conseillerais de mettre tout tes fichiers dans une même répertoire

Et mettre une boucle for

For each fichier in repertoire
copier la feuille questionnaire dans thisworkbook
next

 

[gerson94]

Re : Traiter Questionnaire

Salut Habitude,

Je te conseillerais de mettre tout tes fichiers dans une même répertoire

Et mettre une boucle for

For each fichier in repertoire
copier la feuille questionnaire dans thisworkbook
next

C'est exactement ce que je comptais faire, mais je ne suis pas très bon en VBA, alors je suis en train d'essayer d'écrire ce code en glanant sur le site quelques solutions similaires. Mon truc c'est qu'il doit ouvrir le "question1", copier puis fermer, puis le "question2", etc.
Merci d'avoir regardé.

Gerson

 

[Alguiche]

Re : Traiter Questionnaire

Salut Gerson,

Voilà un code qui ouvre les fichiers les uns après les autres pour autant que leur numérotation soit continue. Sinon il faut gérer les erreurs.

Sub OuvFer()
Dim n As Long

For n = 1 To 300

Workbooks.Open Filename:="D:\TestExcel\Fichier" & n & ".xls"

'.... ton code

ActiveWorkbook.Close
Next n

End Sub


Bonne journée
Al

 

[gerson94]

Re : Traiter Questionnaire

Bonjour Alguiche

Merci pour ce code sur lequel je me suis appuyé pour améliorer le mien pour le coup.

Salut Gerson,

Voilà un code qui ouvre les fichiers les uns après les autres pour autant que leur numérotation soit continue. Sinon il faut gérer les erreurs.

Sub OuvFer()
Dim n As Long

For n = 1 To 300

Workbooks.Open Filename:="D:\TestExcel\Fichier" & n & ".xls"

'.... ton code

ActiveWorkbook.Close
Next n

End Sub


Bonne journée
Al

Alors j'ai fait un Test sur 2 fichiers Questionnaires numérotés Questionnaire1 et Questionnaire2. Ma macro ouvre le premier et fonctionne comme attendu mais ne le referme pas et me propose plutôt de fermer le fichier de synthèse ( ActiveWorkbook.Close) que je souhaite garder ouvert. De plus la macro ne fonctione pas pour ouvrir le Questionnaire2 et ainsi de suite.
Je continue à chercher de mon côté.
Merci

Mon nouveau code

Sub OuvFer()   
Dim n As Long
    For n = 1 To 2
    Workbooks.Open Filename:="D:\Moi\Mes documents\Test\Questionnaire" & n & ".xls"
     ThisWorkbook.Activate
    Sheets("Feuil1").Select
        nbl = Range("E9").CurrentRegion.Rows.Count
    Range("E9:E" & nbl).ClearContents
    Workbooks("Questionnaire" & n & ".xls").Activate
    Range("E9:E48").Select
    Selection.Copy
    ThisWorkbook.Activate
    Range("E9:E48").Select
    Selection.PasteSpecial Paste:=xlPasteValues 
    Range("A3").Select
  
    ActiveWorkbook.Close
    
    Next n
  
End Sub

Gerson

 

[Alguiche]

Re : Traiter Questionnaire

Salut Gerson,

Remplace ActiveWorkBook.Close par

Workbooks("Questionnaire" & n & ".xls").Close

et donne moi des nouvelles.


Sinon un autre code qui prend tous les fichiers d'un dossier donné quel que soit le nom. Attention donc à ce que ton fichier de synthèse ne se trouve pas dans ce répertoire.

Sub OuvFer()

Dim FichSource As Variant


ChDir ("D:\TestExcel\")
FichSource = Dir("*.xls")

Do While FichSource <> ""
Workbooks.Open Filename:=FichSource

'.... ton code

MsgBox ActiveWorkbook.Name
Workbooks(FichSource).Close
FichSource = Dir
Loop


End Sub

Salutations
Al

 

[Alguiche]

Re : Traiter Questionnaire

ReSalut,

Oublie la première partie de mon post précédent.

J'ai adapté ton code comme suit, à essayer

Sub OuvFer()
Dim n As Long

ThisWorkbook.Activate
Sheets("Feuil1").Select
nbl = Range("E9").CurrentRegion.Rows.Count
Range("E9:E" & nbl).ClearContents

For n = 1 To 2

Workbooks.Open Filename:="D:\Moi\Mes documents\Test\Questionnaire" & n & ".xls"
Range("E9:E48").Select
Selection.Copy
Workbooks("Tonfichierdesynthèse").Activate
Range("E9:E48").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("A3").Select

Workbooks("Questionnaire" & n & ".xls").Close

Next n

End Sub

tiens moi au courant

A+
Al

 

[Alguiche]

Re : Traiter Questionnaire

Salut Gerson,

Une petite précision. Fais attention quand tu utilises Activeworkbook que le fichier auquel tu veux faire référence est bien le fichier actif. Quand tu ouvres un fichier par exemple il devient de facto le ActiveWorkbook donc dès que que tu veux de nouveau agir dans ton fichier de départ tu dois de nouveau l'activer.

A+
Al

 

[Alguiche]

Re : Traiter Questionnaire

ReSalut,

Encore une chose.

Dans ton code, chaque fois que tu vas ajouter les données d'un questionnaire dans ton fichier de synthèse elles vont s'inscrire sur les précédentes et en fin de compte tu n'auras dans ton dossier de synthèse que les données du dernier fichier ouvert. Je pense pas que c'est le résultat que tu souhaites?

A+
Al

 

[gerson94]

Re : Traiter Questionnaire

ReSalut,

Encore une chose.

Dans ton code, chaque fois que tu vas ajouter les données d'un questionnaire dans ton fichier de synthèse elles vont s'inscrire sur les précédentes et en fin de compte tu n'auras dans ton dossier de synthèse que les données du dernier fichier ouvert. Je pense pas que c'est le résultat que tu souhaites?

A+
Al

Pertinent ta remarque Alguiche! Effectivement, j'ai une procédure qui permet d'enregistrer sur une autre feuille ce qui a été collé, j'évite donc toute perte de données. Je n'ai pas jugé bon d'insérer cette procédure (peut-être à tort) que j'appelle en "Call_procédure" car ne pose pas problème.
Donc au final les données s'incrémente dans un certain ordre sur une autre feuille.
Je teste ton amélioration et te tiens informé.

Gerson

 

[gerson94]

Re : Traiter Questionnaire

ReSalut,

Encore une chose.

Dans ton code, chaque fois que tu vas ajouter les données d'un questionnaire dans ton fichier de synthèse elles vont s'inscrire sur les précédentes et en fin de compte tu n'auras dans ton dossier de synthèse que les données du dernier fichier ouvert. Je pense pas que c'est le résultat que tu souhaites?

A+
Al

Re-salut,

Tout marche Nickel. J'ai fait le test sur 3 fichiers. Merci pour l'aide Alguiche et à ceux qui ont bien voulu regarder.
Voici le code pour partager:

Sub Proc

Dim n As Long
ThisWorkbook.Activate
Sheets("Feuil1").Select
nbl = Range("E9").CurrentRegion.Rows.Count
Range("E9:E" & nbl).ClearContents

For n = 1 To 3

Workbooks.Open Filename:="D:\Moi\Mes documents\Test\Questionnaire" & n & ".xls"
Range("E9:E48").Select
Selection.Copy
Workbooks("Tableaudesynthèse").Activate
Range("E9:E48").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("A3").Select

Call <mon code pour enregistrer les données sur une autre feuille>

Workbooks("Questionnaire" & n & ".xls").Close

Next n

End Sub

Merci beaucoup, problème résolu pour moi.

Gerson