Quelqu'un pourrait il m'aider - merci
j'ai fait une macro sous vba excel  
le but c'est de rechercher dans un répertoire tous les fichiers excel - les ouvrir- déproteger- trier  et pour chacun d'eux - lire chaque ligne et en fonction du résultat le stoker dans le fichier maitre.
j'ai réussi à peu près - mais il s'arrête au 1er enregistrement du second fichier  -
mon problème est que le traitement du 1er ne se fait pas pour le second à partir de la boucle do while - voir pb de workbooks(i) !!
merci d'avance - je suis bloquée et ca m'énerve  
 
 
Sub traitement()
 
Set fichcherche = Application.FileSearch  ' va chercher dans le répertoire à copier les fichiers
With fichcherche
 
.LookIn = "Q:\SECRET\FICHIERS\programmation\à copier\"  'Changer le chemin si nécessaire
.Filename = "*.xls" 'ou "*.txt"   ' va rechercher tous les fichiers excel
If .Execute > 0 Then  'va indiquer le nombre de fichiers trouvés
MsgBox .FoundFiles.Count & " Fichier(s) a (ont) été trouvé(s)."
For i = 1 To .FoundFiles.Count 'tant qu'il y a des fichiers excel dans ce répertoire
Workbooks.Open Filename:=.FoundFiles(i) 'ouvre le fichier à copier
 
ActiveSheet.Select  ' selectionne la feuille active
ActiveSheet.Unprotect  ' retire la protection de la feuille
Range("A5:AD3648" ).Select  'selectionne la plage des données (modifiable)
    Selection.Sort Key1:=Range("B6" ), Order1:=xlAscending, Key2:=Range("C6" ) _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal  ' tri les données par ligne de programme puis instructeur
Range("B6" ).Select 'selectionne le 1er enregistrement
         
     Do While ActiveCell.Value <> ""
     
    If ActiveCell.Value = "110" Then  ' si valeur = 110
     ActiveCell.EntireRow.Select
     Selection.Copy
    ThisWorkbook.Activate  'selection du fichier de réception
     Sheets("synthese110" ).Select ' selection de la feuille
     Range("b5" ).Select ' selection de la 1ere ligne d'enregistrement
        If Not (IsEmpty(ActiveCell.Offset(1, 0))) Then 'test que 1ere cellule n'est pas vide
       Selection.End(xlDown).Select
        End If
     ActiveCell.Offset(1, -1).Select
     ActiveSheet.Paste  ' colle
     Workbooks(i).Activate
   ActiveCell.Offset(1, 1).Select  ' va se déplacer d'une ligne et prend la valeur
    Else
         
    If ActiveCell.Value = "120" Then  ' tant que valeur =120
     ActiveCell.EntireRow.Select
     Selection.Copy
      ThisWorkbook.Activate  'selection du fichier de réception
     Sheets("synthese120" ).Select ' selection de la feuille
     Range("b5" ).Select ' selection de la 1ere ligne d'enregistrement
        If Not (IsEmpty(ActiveCell.Offset(1, 0))) Then 'test que 1ere cellule n'est pas vide
       Selection.End(xlDown).Select
        End If
     ActiveCell.Offset(1, -1).Select
     ActiveSheet.Paste  ' colle
     Workbooks(i).Activate
   ActiveCell.Offset(1, 1).Select  ' va se déplacer d'une ligne et prend la valeur
    Else
     
    If ActiveCell.Value = "250" Then  ' tant que valeur =120
     ActiveCell.EntireRow.Select
     Selection.Copy
      ThisWorkbook.Activate  'selection du fichier de réception
     Sheets("synthese250" ).Select ' selection de la feuille
     Range("b5" ).Select ' selection de la 1ere ligne d'enregistrement
        If Not (IsEmpty(ActiveCell.Offset(1, 0))) Then 'test que 1ere cellule n'est pas vide
       Selection.End(xlDown).Select
        End If
     ActiveCell.Offset(1, -1).Select
     ActiveSheet.Paste  ' colle
      Workbooks(i).Activate
   ActiveCell.Offset(1, 1).Select  ' va se déplacer d'une ligne et prend la valeur
     End If
     End If
     End If
 
     
     Loop
     
   'Workbooks(i).Activate
    'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    'ChDir "Q:\SECRET\FICHIERS\programmation\traité"  ' selection du repertoire traité
    'ActiveWorkbook.Save 'sauvegarde
    'ActiveWorkbook.Close 'fermeture
On Error Resume Next
 
Next i
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With

j'ai trouvé moi meme la solution  
merci quand meme

quand on trouve tout seul, on donne la soluce aux autres stp    certains ont cherché pour toi, alors si tu trouves, tu clos le topic, et tu indik les clés

Autre chose aussi.. essaye de decouper ta fonction en sous-fonctions.. chacune effectuant une seule et unique tache.. avec un nom explicite.
Ca simplifie grandement la relecture.. car la j'ai sursauté devant toutes ces lignes de code (meme pas indenté) !