Extraire les feuilles "SEM1" de fichiers excel fermés via un nouveau classeur

[verolyde]

Bjr,

Je souhaiterai extraire les feuilles nommées "SEM1" de fichiers excel fermés (DH GUYON12.xls) via un nouveau classeur.

Le classeur serait ouvert et je souhaiterai y extraire toutes les feuilles nommées "SEM1" des classeurs excel fermés, toutes situées dans le même répertoire F:\CONGES2\PERSONNEL\YVELINES OUEST\GUYANCOURT\- DECOMPTES TEMPS\DH GUYON12.xls

Les feuilles se rangeront les unes après les autres en changeant le nom de la feuille et en prenant le nom d'où elles ont été extraites, si possible. Sinon, 1, 2...

Merci de votre aide, car j'y suis depuis ce matin et je tourne en rond.

Verolyde

 

[JNP]

Re : Extraire les feuilles "SEM1" de fichiers excel fermés via un nouveau classeur

Bonjour Verolyde ,
A tester

Sub Test()
Dim Chemin As String, Dossier As Object, Fichier As Object, Classeur As Workbook, Feuille As Worksheet
Chemin = "F:\CONGES2\PERSONNEL\YVELINES OUEST\GUYANCOURT\- DECOMPTES TEMPS\"
Application.ScreenUpdating = False
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
    If Fichier.Name <> ThisWorkbook.Name And Right(Fichier.Name, 4) = ".xls" Then
        Workbooks.Open (Chemin & Fichier.Name)
        Set Classeur = ActiveWorkbook
        For Each Feuille In Classeur.Worksheets
            If Feuille.Name = "SEM1" Then
                Feuille.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                ThisWorkbook.Sheets("SEM1").Name = Replace(Fichier.Name, ".xls", "")
            End If
        Next Feuille
        Classeur.Close False
    End If
Next Fichier
Application.ScreenUpdating = True
End Sub

Bon réveillon