Coier des feuilles de plusieurs fichiers excel vers un seul

[nonoTT]

Bonjour
Après avoir fait une petite recherche sur le forum, je suis tombé la dessus :

Sub c()
Dim nom$, WBKSource As Workbook
With Application.FileDialog(msoFileDialogOpen)' ton bout de code
   .Title = "Choisissez le fichier"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xls*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom) ' mon petit bout à moi ;-)
           With WBKSource
                .Sheets("Activités").Copy Before:=ThisWorkbook.Sheets(1)
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With
End Sub

issu de ce sujet : https://www.excel-downloads.com/threads/importer-une-feuille-excel-depuis-un-autre-classeur.176033/

Je souhaite l'adapter pour insérer 2 fichiers dans mon fichier de synthèse, voilà ce que j'ai écrit (recopié) mais ça ne marche pas tout à fait :

Sub IMPORT()

Dim nom$, nom2$, WBKSource, WBKSource2 As Workbook
' sélectionne et copie la feuille Rejets du fichier sélectionné
' et la colle dans la feuille avant la feuille Synthese
With Application.FileDialog(msoFileDialogOpen) '
   .Title = "Choisissez le fichier où les Rejets sont comptabilisés"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xlsx*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom) ' mon petit bout à moi ;-)
           With WBKSource
                .Sheets("Rejets").Copy before:=ThisWorkbook.Sheets("Synthese")
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With

' sélectionne et copie la feuille Totaux du fichier sélectionné
' et la colle dans la feuille avant la feuille Synthese

With Application.FileDialog(msoFileDialogOpen) '
   .Title = "Choisissez le fichier où les totaux sont comptabilisés"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xlsx*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom2 = .SelectedItems(1)
            Set WBKSource2 = Workbooks.Open(nom) ' mon petit bout à moi ;-)
           With WBKSource2
                .Sheets("Totaux").Copy before:=ThisWorkbook.Sheets("Synthese")
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With
End Sub

2 problèmes apparaissent :
- je suis obligé d'éxécuter et d'insérer cette macro dans le fichier qui va me servir de résultat
- J'ai une erreur d'exécution '9': L'indice n'appartient pas à la sélection
- le code ne m'apparaît pas très optimisé.
Merci de m'aider.
Cordialement.

 

[PrinceCorwin]

Re : Coier des feuilles de plusieurs fichiers excel vers un seul

Bonjour,

Voici une modification du programme

Sub ImportFichier()

 Dim nom As String
 Dim WBKSource As Workbook
 Dim myBook As Workbook
 
 Set myBook = ThisWorkbook
 
 With Application.FileDialog(msoFileDialogOpen) ' ouverture de la dialogFichier
    .Title = "Choisissez le(s) fichier(s)"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xls*"
    .AllowMultiSelect = True
    If .Show <> 0 Then
        If .SelectedItems.Count > 1 Then            'Si selection multiple de fichiers
            For i = 1 To .SelectedItems.Count
                nom = .SelectedItems(i)
                Set WBKSource = Workbooks.Open(nom)
                WBKSource.Sheets("Activites").Copy
                myBook.Sheets.Add before:=myBook.Sheets(1)
                myBook.ActiveSheet.Paste
                myBook.Sheets(1).Name = i & " Activites"
                WBKSource.Close False
            Next i
        Else
        'Selection unique de fichier
            nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom)
            WBKSource.Sheets("Activites").Copy
            myBook.Sheets.Add before:=myBook.Sheets(1)
            myBook.ActiveSheet.Paste
            myBook.Sheets(1).Name = "1 Activites"
            WBKSource.Close False
        End If
    Else                                    'Pas de selection de fichier
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
    End If
 End With
 End Sub

Bonne journée

 

[nonoTT]

Re : Copier des feuilles de plusieurs fichiers excel vers un seul

Bonjour je viens de corriger ma macro, je n'ai pas fait assez attention à une variable.

Sub IMPORT()

Dim nom$, nom2$, WBKSource, WBKSource2 As Workbook
' sélectionne et copie la feuille Rejets du fichier sélectionné
' et la colle dans la feuille avant la feuille Synthese
With Application.FileDialog(msoFileDialogOpen)
   .Title = "Choisissez le fichier où les Rejets sont comptabilisés"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xlsx*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom) ' mon petit bout à moi ;-)
           With WBKSource
                .Sheets("Rejets").Copy before:=ThisWorkbook.Sheets("Synthese")
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With

' sélectionne et copie la feuille Totaux du fichier sélectionné
' et la colle dans la feuille avant la feuille Synthese


With Application.FileDialog(msoFileDialogOpen)
   .Title = "Choisissez le fichier où les totaux sont comptabilisés"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xlsx*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom2 = .SelectedItems(1)
            Set WBKSource2 = Workbooks.Open(nom2)
           With WBKSource2
                .Sheets("Totaux").Copy before:=ThisWorkbook.Sheets("Synthese")
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With
End Sub

Elle fonctionne toujours est-il que 2 éléments ne me satisfont pas :
- comment lancer cette macro sans qu'elle soit associée aux résultats ?
- comment la simplifier ?
Cordialement.
PS
--> PrinceCorwin
je n'ai pas réussi à faire fonctionner ta macro.

 

[nonoTT]

Re : Coier des feuilles de plusieurs fichiers excel vers un seul

J'ai encore modifier la macro et j'arrive presque à mes fins sauf que j'ai une erreur d'éxécution 424 : Objet requis sur la ligne suivante de ma macro

  .Sheets("Rejets").Copy before:=Mybook.Sheets("Synthese")

dans la macro suivante:

 Sub IMPORT()

Dim nom$, nom2$, WBKSource, WBKSource2 As Workbook
'Sélectionne un fichier et le stocke dans la variable Mybook
Mybook = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
If Mybook <> False Then
    Workbooks.Open Mybook
End If

' sélectionne et copie la feuille Rejets du fichier sélectionné
' et la colle dans la feuille avant la feuille Synthese
With Application.FileDialog(msoFileDialogOpen) '
   .Title = "Choisissez le fichier où les Rejets sont comptabilisés"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xlsx*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom) ' mon petit bout à moi ;-)
           With WBKSource
                .Sheets("Rejets").Copy before:=Mybook.Sheets("Synthese")
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With

' sélectionne et copie la feuille Totaux du fichier sélectionné
' et la colle dans la feuille avant la feuille Synthese


With Application.FileDialog(msoFileDialogOpen) '
   .Title = "Choisissez le fichier où les totaux sont comptabilisés"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xlsx*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom2 = .SelectedItems(1)
            Set WBKSource2 = Workbooks.Open(nom2) ' mon petit bout à moi ;-)
           With WBKSource2
                .Sheets("Totaux").Copy before:=Mybook.Worksheets("Synthese")
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With

End Sub

il me semble pourtant que la variable Mybook et WBKSource sont différentes ?
Comment corrigé cela?
Cordialement.