Aide macro excel Fermé

Question

Bonjour, 
je suis plus que débutant sur excel et je cherche  un moyen de créer une macro pour copier 1 feuille de plusieurs fichiers différents dans un seul fichier excel
je m'explique: j'ai plusieurs fichiers ( *QCon.xls ) l'étoile représente le numéro de la semaine
                      et je voudrais en copier la feuille 1 dans un autre fichier excel ( suivi.xls ) en les
                      nommant par le numéro de semaine ( ex: 01,02,.....,52)
                     sachant donc que j'ai 52 fichiers ( 01QCON.xls,02QCON.xls,.....)
j'arrive bien à le faire pour une semaine mais quand il s'agit de répéter l'opération 52 fois et en
incrémantant les numéros de feuilles là je bois la tasse!

Aidez-moi svp

pijaku · Answer

Salut,
Pas trop tard??
Une solution :
1- créer un fichier excel et le nommer : suivi.xls
2- dans ce classeur, aleez sous VBA (CTRL+F11)
3- Insertion/Module
4- copier/coller ce code dans le module puis fermez la fenêtre VBA :

Sub copie_feuilles()
'http://www.commentcamarche.net/faq/16109-excel-convertir-fichier-s-csv-xls#selectionner-le-chemin-par-boite-de-dialogue
'Lermitte222
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim tablo
Dim nomfich, nomfeuil As String
Dim i As Integer
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous)
    Set oFolderItem = objFolder.Items.Item
    chemin = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
'------------------------------------------
'http://www.commentcamarche.net/forum/affich-7805734-vba-excel-lister-fichiers-caracteristique
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = chemin
.SearchSubFolders = True
.Filename = "xls"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
For Each NomFic In .FoundFiles
Workbooks.Open Filename:=NomFic
'------------------------------------------
'http://www.commentcamarche.net/forum/affich-18381562-trouver-un-fichier-vba-excel#5
'michel_m
tablo = Split(NomFic, "\")
nomfich = tablo(UBound(tablo))
nomfeuil = Left(nomfich, 2)
With Workbooks("suivi.xls")
For i = 1 To .Sheets.Count
    If .Sheets(i).Name = nomfeuil Then
        MsgBox "La feuille " & nomfeuil & " existe déjà"
        GoTo suivant
    End If
Next
End With
'-------------------------------------------
Workbooks(nomfich).Sheets("Feuil1").Select
Workbooks(nomfich).Sheets("Feuil1").Copy After:=Workbooks("suivi.xls").Sheets(3)
ActiveSheet.Name = nomfeuil
suivant:
Workbooks(nomfich).Activate
Workbooks(nomfich).Close
Next
End With
[Les sources sont citées en commentaire dans ce code.]
Enregistrer le classeur suivi.xls, puis lancez la macro par CTRL+F8, choisir : copie_feuilles et cliquer sur Exécuter.
Bon courage

Aide macro excel

1 réponse

Discussions similaires