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
certains ont cherché pour toi, alors si tu trouves, tu clos le topic, et tu indik les clés 