VBA Copier des classeurs vers un autre dossier en les renommant mais sans les ouvrir
3 réponses
Céline Brien
Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:\Report\Nov\"
StrPath2 = "R:\Report\PasTouche\"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:\Report\PasTouche\*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , ,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichDenis
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" a écrit dans le message de news:
Bonjour à tous, Est-il possible de copier des classeurs vers un autre dossier en les renommant, mais sans les ouvrir ? Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me semble que l'exécution serait plus rapide. Vous trouverez ci-dessous des codes qui effectuent le travail, mais en ouvrant les classeurs. Merci de votre aide précieuse, Céline ---------------------------------------- Sub ImporterNov() 'Chemin d'accès des fichiers du mois StrPath = "R:ReportNov" StrPath2 = "R:ReportPasTouche" 'Supprimer les fichiers dans le dossier PasTouche Kill "R:ReportPasTouche*.xls" 'Ouverture d'Excel Dim waExcel Set waExcel = CreateObject("Excel.Application") 'Rendre Excel invisible waExcel.Visible = False 'Rechercher les fichiers xls, les compter et les sauvegarer du premier au dernier dans PasTouche With waExcel.Application.FileSearch .LookIn = StrPath .SearchSubFolders = True .Filename = "*.xls" .Execute If .FoundFiles.Count > 0 Then For i = 1 To .FoundFiles.Count If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then StrFich = Dir(.FoundFiles(i)) 'Ouvrir le fichier xls waExcel.Workbooks.Open .FoundFiles(i) 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en utilisant les 2 caractères à droite et en mode partagé pour éviter des erreurs. waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , , , 2 End If ' waExcel.Workbooks.Close waExcel.ActiveWorkbook.Close Next i End If End With 'Fermeture d'Excel waExcel.Application.Quit End Sub
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" <celinebrien@laurentides.qc.ca> a écrit dans le message de news:
OXgcneTdHHA.4888@TK2MSFTNGP02.phx.gbl...
Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:ReportNov"
StrPath2 = "R:ReportPasTouche"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:ReportPasTouche*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , ,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" a écrit dans le message de news:
Bonjour à tous, Est-il possible de copier des classeurs vers un autre dossier en les renommant, mais sans les ouvrir ? Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me semble que l'exécution serait plus rapide. Vous trouverez ci-dessous des codes qui effectuent le travail, mais en ouvrant les classeurs. Merci de votre aide précieuse, Céline ---------------------------------------- Sub ImporterNov() 'Chemin d'accès des fichiers du mois StrPath = "R:ReportNov" StrPath2 = "R:ReportPasTouche" 'Supprimer les fichiers dans le dossier PasTouche Kill "R:ReportPasTouche*.xls" 'Ouverture d'Excel Dim waExcel Set waExcel = CreateObject("Excel.Application") 'Rendre Excel invisible waExcel.Visible = False 'Rechercher les fichiers xls, les compter et les sauvegarer du premier au dernier dans PasTouche With waExcel.Application.FileSearch .LookIn = StrPath .SearchSubFolders = True .Filename = "*.xls" .Execute If .FoundFiles.Count > 0 Then For i = 1 To .FoundFiles.Count If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then StrFich = Dir(.FoundFiles(i)) 'Ouvrir le fichier xls waExcel.Workbooks.Open .FoundFiles(i) 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en utilisant les 2 caractères à droite et en mode partagé pour éviter des erreurs. waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , , , 2 End If ' waExcel.Workbooks.Close waExcel.ActiveWorkbook.Close Next i End If End With 'Fermeture d'Excel waExcel.Application.Quit End Sub
Céline Brien
Salut Mich, Merci beaucoup pour ta réponse. Le nom des fichiers dans ancien chemin est : 01nov06.xls 02nov06.xls L'an prochain le nom des fichiers sera : 01nov07.xls 02nov07.xls De plus, en février, le nombre de fichiers variera d'un année à l'autre. La commande peut-elle être quelque chose comme ??? ----------------------------------------------------------------- Name StrPath & StrFich As StrPath2 & Left(StrFich, 2) ----------------------------------------------------------------- Merci encore et bonne journée, Céline
"MichDenis" a écrit dans le message de news:
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" a écrit dans le message de news:
Bonjour à tous, Est-il possible de copier des classeurs vers un autre dossier en les renommant, mais sans les ouvrir ? Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me semble que l'exécution serait plus rapide. Vous trouverez ci-dessous des codes qui effectuent le travail, mais en ouvrant les classeurs. Merci de votre aide précieuse, Céline ---------------------------------------- Sub ImporterNov() 'Chemin d'accès des fichiers du mois StrPath = "R:ReportNov" StrPath2 = "R:ReportPasTouche" 'Supprimer les fichiers dans le dossier PasTouche Kill "R:ReportPasTouche*.xls" 'Ouverture d'Excel Dim waExcel Set waExcel = CreateObject("Excel.Application") 'Rendre Excel invisible waExcel.Visible = False 'Rechercher les fichiers xls, les compter et les sauvegarer du premier au dernier dans PasTouche With waExcel.Application.FileSearch .LookIn = StrPath .SearchSubFolders = True .Filename = "*.xls" .Execute If .FoundFiles.Count > 0 Then For i = 1 To .FoundFiles.Count If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then StrFich = Dir(.FoundFiles(i)) 'Ouvrir le fichier xls waExcel.Workbooks.Open .FoundFiles(i) 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en utilisant les 2 caractères à droite et en mode partagé pour éviter des erreurs. waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , , , 2 End If ' waExcel.Workbooks.Close waExcel.ActiveWorkbook.Close Next i End If End With 'Fermeture d'Excel waExcel.Application.Quit End Sub
Salut Mich,
Merci beaucoup pour ta réponse.
Le nom des fichiers dans ancien chemin est :
01nov06.xls
02nov06.xls
L'an prochain le nom des fichiers sera :
01nov07.xls
02nov07.xls
De plus, en février, le nombre de fichiers variera d'un année à l'autre.
La commande peut-elle être quelque chose comme ???
-----------------------------------------------------------------
Name StrPath & StrFich As StrPath2 & Left(StrFich, 2)
-----------------------------------------------------------------
Merci encore et bonne journée,
Céline
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
ubgrjnTdHHA.1000@TK2MSFTNGP05.phx.gbl...
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" <celinebrien@laurentides.qc.ca> a écrit dans le message de
news:
OXgcneTdHHA.4888@TK2MSFTNGP02.phx.gbl...
Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:ReportNov"
StrPath2 = "R:ReportPasTouche"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:ReportPasTouche*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , ,
,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub
Salut Mich, Merci beaucoup pour ta réponse. Le nom des fichiers dans ancien chemin est : 01nov06.xls 02nov06.xls L'an prochain le nom des fichiers sera : 01nov07.xls 02nov07.xls De plus, en février, le nombre de fichiers variera d'un année à l'autre. La commande peut-elle être quelque chose comme ??? ----------------------------------------------------------------- Name StrPath & StrFich As StrPath2 & Left(StrFich, 2) ----------------------------------------------------------------- Merci encore et bonne journée, Céline
"MichDenis" a écrit dans le message de news:
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" a écrit dans le message de news:
Bonjour à tous, Est-il possible de copier des classeurs vers un autre dossier en les renommant, mais sans les ouvrir ? Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me semble que l'exécution serait plus rapide. Vous trouverez ci-dessous des codes qui effectuent le travail, mais en ouvrant les classeurs. Merci de votre aide précieuse, Céline ---------------------------------------- Sub ImporterNov() 'Chemin d'accès des fichiers du mois StrPath = "R:ReportNov" StrPath2 = "R:ReportPasTouche" 'Supprimer les fichiers dans le dossier PasTouche Kill "R:ReportPasTouche*.xls" 'Ouverture d'Excel Dim waExcel Set waExcel = CreateObject("Excel.Application") 'Rendre Excel invisible waExcel.Visible = False 'Rechercher les fichiers xls, les compter et les sauvegarer du premier au dernier dans PasTouche With waExcel.Application.FileSearch .LookIn = StrPath .SearchSubFolders = True .Filename = "*.xls" .Execute If .FoundFiles.Count > 0 Then For i = 1 To .FoundFiles.Count If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then StrFich = Dir(.FoundFiles(i)) 'Ouvrir le fichier xls waExcel.Workbooks.Open .FoundFiles(i) 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en utilisant les 2 caractères à droite et en mode partagé pour éviter des erreurs. waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , , , 2 End If ' waExcel.Workbooks.Close waExcel.ActiveWorkbook.Close Next i End If End With 'Fermeture d'Excel waExcel.Application.Quit End Sub
Céline Brien
Salut à tous, Salut Mich, Je vais devoir garder mes codes qui ouvrent le fichier pour le renommer et l'enregistrer dans un autre dossier car je viens tout juste de réaliser qu'il faut aussi renommer l'onglet en passsant. Merci encore de ton aide, Céline
"Céline Brien" a écrit dans le message de news:
Salut Mich, Merci beaucoup pour ta réponse. Le nom des fichiers dans ancien chemin est : 01nov06.xls 02nov06.xls L'an prochain le nom des fichiers sera : 01nov07.xls 02nov07.xls De plus, en février, le nombre de fichiers variera d'un année à l'autre. La commande peut-elle être quelque chose comme ??? ----------------------------------------------------------------- Name StrPath & StrFich As StrPath2 & Left(StrFich, 2) ----------------------------------------------------------------- Merci encore et bonne journée, Céline
"MichDenis" a écrit dans le message de news:
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" a écrit dans le message de news:
Bonjour à tous, Est-il possible de copier des classeurs vers un autre dossier en les renommant, mais sans les ouvrir ? Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me semble que l'exécution serait plus rapide. Vous trouverez ci-dessous des codes qui effectuent le travail, mais en ouvrant les classeurs. Merci de votre aide précieuse, Céline ---------------------------------------- Sub ImporterNov() 'Chemin d'accès des fichiers du mois StrPath = "R:ReportNov" StrPath2 = "R:ReportPasTouche" 'Supprimer les fichiers dans le dossier PasTouche Kill "R:ReportPasTouche*.xls" 'Ouverture d'Excel Dim waExcel Set waExcel = CreateObject("Excel.Application") 'Rendre Excel invisible waExcel.Visible = False 'Rechercher les fichiers xls, les compter et les sauvegarer du premier au dernier dans PasTouche With waExcel.Application.FileSearch .LookIn = StrPath .SearchSubFolders = True .Filename = "*.xls" .Execute If .FoundFiles.Count > 0 Then For i = 1 To .FoundFiles.Count If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then StrFich = Dir(.FoundFiles(i)) 'Ouvrir le fichier xls waExcel.Workbooks.Open .FoundFiles(i) 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en utilisant les 2 caractères à droite et en mode partagé pour éviter des erreurs. waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , , , 2 End If ' waExcel.Workbooks.Close waExcel.ActiveWorkbook.Close Next i End If End With 'Fermeture d'Excel waExcel.Application.Quit End Sub
Salut à tous,
Salut Mich,
Je vais devoir garder mes codes qui ouvrent le fichier pour le renommer et
l'enregistrer dans un autre dossier car je viens tout juste de réaliser
qu'il faut aussi renommer l'onglet en passsant.
Merci encore de ton aide,
Céline
"Céline Brien" <celinebrien@laurentides.qc.ca> a écrit dans le message de
news: OLr6yAUdHHA.4188@TK2MSFTNGP02.phx.gbl...
Salut Mich,
Merci beaucoup pour ta réponse.
Le nom des fichiers dans ancien chemin est :
01nov06.xls
02nov06.xls
L'an prochain le nom des fichiers sera :
01nov07.xls
02nov07.xls
De plus, en février, le nombre de fichiers variera d'un année à l'autre.
La commande peut-elle être quelque chose comme ???
-----------------------------------------------------------------
Name StrPath & StrFich As StrPath2 & Left(StrFich, 2)
-----------------------------------------------------------------
Merci encore et bonne journée,
Céline
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
ubgrjnTdHHA.1000@TK2MSFTNGP05.phx.gbl...
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As
"c:Nouveau_CheminClasseur1.xls"
"Céline Brien" <celinebrien@laurentides.qc.ca> a écrit dans le message de
news:
OXgcneTdHHA.4888@TK2MSFTNGP02.phx.gbl...
Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:ReportNov"
StrPath2 = "R:ReportPasTouche"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:ReportPasTouche*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , ,
,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub
Salut à tous, Salut Mich, Je vais devoir garder mes codes qui ouvrent le fichier pour le renommer et l'enregistrer dans un autre dossier car je viens tout juste de réaliser qu'il faut aussi renommer l'onglet en passsant. Merci encore de ton aide, Céline
"Céline Brien" a écrit dans le message de news:
Salut Mich, Merci beaucoup pour ta réponse. Le nom des fichiers dans ancien chemin est : 01nov06.xls 02nov06.xls L'an prochain le nom des fichiers sera : 01nov07.xls 02nov07.xls De plus, en février, le nombre de fichiers variera d'un année à l'autre. La commande peut-elle être quelque chose comme ??? ----------------------------------------------------------------- Name StrPath & StrFich As StrPath2 & Left(StrFich, 2) ----------------------------------------------------------------- Merci encore et bonne journée, Céline
"MichDenis" a écrit dans le message de news:
Évidemment le classeur doit être fermé.
Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"
"Céline Brien" a écrit dans le message de news:
Bonjour à tous, Est-il possible de copier des classeurs vers un autre dossier en les renommant, mais sans les ouvrir ? Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me semble que l'exécution serait plus rapide. Vous trouverez ci-dessous des codes qui effectuent le travail, mais en ouvrant les classeurs. Merci de votre aide précieuse, Céline ---------------------------------------- Sub ImporterNov() 'Chemin d'accès des fichiers du mois StrPath = "R:ReportNov" StrPath2 = "R:ReportPasTouche" 'Supprimer les fichiers dans le dossier PasTouche Kill "R:ReportPasTouche*.xls" 'Ouverture d'Excel Dim waExcel Set waExcel = CreateObject("Excel.Application") 'Rendre Excel invisible waExcel.Visible = False 'Rechercher les fichiers xls, les compter et les sauvegarer du premier au dernier dans PasTouche With waExcel.Application.FileSearch .LookIn = StrPath .SearchSubFolders = True .Filename = "*.xls" .Execute If .FoundFiles.Count > 0 Then For i = 1 To .FoundFiles.Count If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then StrFich = Dir(.FoundFiles(i)) 'Ouvrir le fichier xls waExcel.Workbooks.Open .FoundFiles(i) 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en utilisant les 2 caractères à droite et en mode partagé pour éviter des erreurs. waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , , , 2 End If ' waExcel.Workbooks.Close waExcel.ActiveWorkbook.Close Next i End If End With 'Fermeture d'Excel waExcel.Application.Quit End Sub