Copier plusieur feuilles dans une

Question

Bonjour ;

J’ai plusieurs classeur Excel, chaque un contient plusieurs feuilles, dans tous les classeurs il y a une feuilles Nommé CHARGE qui contient des informations par jour de la charge, Alor mois je veux copie le contenue de tous les feuilles nommé CHARGE, dans une seul feuille pour faire l’analyse du mois

Je cherche maintenant comment faire une copie coller automatiquement parce que Ilya 400 feuille

Merci de votre aide.

lermite · Answer

Quel est la plage à copier à partir des feuilles CHARGE ? Les classeurs sont répertorier comment ? leur nom ? Dans quel feuille ça doit "atterrir" ? A+...

lermite · Answer

Re,

Tu dis 400 pages à copier mais du 01 au 30 il n'y a que 30 feuilles. Tu devras éventuellement adapter les noms des classeurs ou donner plus de détails.

Les données devraient êtres l'une en dessous de l'autre, tu ne précise pas !

Code à copier dans un module général. Pas tester. (J'ai pas tes classeurs)

Option Explicit

Sub CopieFeuilles()
Dim Chemin As String, Ext As String
Dim NomFich As String, Num As String
Dim WkCopie As Workbook, WkSource As Workbook
Dim i As Long, Lig As Long
'-----------------------------------------------------------
    'Sélectionner le répertoir
    Chemin = SelectionRep
    'Ou mettre le chemin en dur
'-----------------------------------------------------------
    Ext = "xlsx" 'adapter l'extention des fichiers
    NomFich = "etude du 01."
'-----------------------------------------------------------
    Lig = 1
    Set WkCopie = Workbooks.Add
    Application.ScreenUpdating = False
    For i = 1 To 30
        Num = "0" & i
        Set WkSource = Workbooks.Open(Chemin & NomFich & Right(Num, 2) & "." & Ext)
        WkSource.Sheets("Charge").Range("A1:L120").Copy WkCopie.Sheets("Feuil1").Range("A" & Lig)
        Lig = Lig + 122
        WkSource.Close
    Next
    Application.ScreenUpdating = True
    WkCopie.SaveAs ("NomRécap.." & Ext)

End Sub

'Sélectionner le chemin par boite de dialogue
Function SelectionRep()
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous)
    Set oFolderItem = objFolder.Items.Item
    SelectionRep = oFolderItem.Path & "\"
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
End Function

Tu dis..

A+