Copier/coller des feuilles de fichiers différents dans un seul fichier

Hello,

je cherche à transférer les data de plusieurs fichiers (maximum 4 fichiers - même structure - une feuille par fichier) dans un seul fichier, même structure mais dans plusieurs onglets.

- ll faudrait pouvoir selectionner les differents fichiers sources en même temps

- Le nom des onglets des fichiers sources et du fichier de destination ne sont pas les mêmes mais le transfert des data peut se coller dans n'importe quel onglet de destination, c'est pas important

- A chaque import, il faudrait que les data à l'interieur du fichier de destination soient supprimer avant de coller les nouvelles données

- Dans le fichier de destination, j'ai appelé les extracts: extract 1, extract 2, Extract 3 et Extract 4. le souci c'est que j'ai d'autres onglets encore dans ce fichier et je ne veux pas qu'ils soient pris en compte dans la macro. j'arrive pas à le faire...

J'ai déjà commencé un truc, j'arrive à tout copier dans le même onglet mais je n'arrive pas à le faire dans plusieurs onglets (en dessous mon code pour coller tout dans un seul onglet dans le fichier de destination), pouvez- vous m'aider svp pour coller dans différents onglets mais dans le même fichier svp ?

Sub Exportdata()
    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "CHOIX du FICHIER"
        .Filters.Clear
        .Filters.Add "Fichier Excel (*.xls)", "*.xls"

        If .Show = True Then
            effacerdonnées
            Dim fPath As Variant
            For Each fPath In .SelectedItems
                ' Use 'fPath' to do whatever you want.
                CopyContentFile (fPath)
            Next
        End If
    End With
End Sub

-------------------------------

Sub effacerdonnées()
'
' test Macro
'

'effacer les données de la feuille d'extract delmia
    ThisWorkbook.Sheets("Extract préparation tracker").Select
    Rows("3:1000000").Select
    Selection.Clear
    Range("A3").Select

End Sub

-----------------------

Sub CopyContentFile(fPath As Variant)

  Dim Wbk As Workbook, ShtS As Worksheet
  Dim dLigS As Long ' Dernière ligne du fichier source
  Dim dLigA As Long ' derniere ligne de l'onglet destination
  ' Ouvrir le fichier sélectionné
  Set Wbk = Workbooks.Open(fPath)
  ' Définir la feuille à traiter du classeur ouvert
  Set ShtS = Wbk.Sheets(1)

' Dernière ligne remplie de la feuille
  dLigS = ShtS.Range("A" & Rows.Count).End(xlUp).Row

    ' Avec ce classeur
  With ThisWorkbook.Sheets("Extract1")
    ' copier/Coller les données
      dLigA = .Range("A" & Rows.Count).End(xlUp).Row + 1
    ShtS.Range("A3:AE" & dLigS).Copy Destination:=.Range("A" & dLigA)
  End With
  ' Ferme le classeur ouvert
  Wbk.Close SaveChanges:=False
  ' Effacer les variables objet
  Set ShtS = Nothing: Set Wbk = Nothing

End Sub

merci beaucoup

Lucas

-------

Bonsoir,

Il serait mieux d'utiliser Power Query

Bonne soirée

Je ne connais pas… comment l’utiliser

Hello,

QUelqu'un pourrait-il m'aider?

Muriella

Bonjour !

A tester :

Sub Exportdata()
    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "CHOIX du FICHIER"
        .Filters.Clear
        .Filters.Add "Fichier Excel (*.xls)", "*.xls"

        If .Show = True Then
            Dim fPath As Variant
            Dim FileCount As Integer ' Compteur de fichier
            FileCount = 1 ' On commence le compteur à 1
            For Each fPath In .SelectedItems
                ' Appeler la fonction effacerdonnées pour chaque onglet d'extraction
                effacerdonnées "Extract" & FileCount
                ' On utilise le compteur de fichiers pour sélectionner l'onglet approprié
                CopyContentFile fPath, "Extract" & FileCount
                FileCount = FileCount + 1 ' Incrémenter le compteur
            Next
        End If
    End With
End Sub

' J'ai modifié la fonction effacerdonnées pour prendre en compte le nom de l'onglet
Sub effacerdonnées(sheetName As String)
    ThisWorkbook.Sheets(sheetName).Rows("3:1000000").Clear
End Sub

' J'ai ajouté un argument pour le nom de l'onglet dans cette fonction
Sub CopyContentFile(fPath As Variant, sheetName As String)
  Dim Wbk As Workbook, ShtS As Worksheet
  Dim dLigS As Long 
  Dim dLigA As Long 

  Set Wbk = Workbooks.Open(fPath)
  Set ShtS = Wbk.Sheets(1)
  dLigS = ShtS.Range("A" & Rows.Count).End(xlUp).Row

  With ThisWorkbook.Sheets(sheetName)
      dLigA = .Range("A" & Rows.Count).End(xlUp).Row + 1
    ShtS.Range("A3:AE" & dLigS).Copy Destination:=.Range("A" & dLigA)
  End With

  Wbk.Close SaveChanges:=False
  Set ShtS = Nothing: Set Wbk = Nothing
End Sub

Ce code suppose que vous n'avez que 4 fichiers ou moins et que les onglets où vous voulez copier les données sont nommés "Extract1", "Extract2", "Extract3" et "Extract4". Si vous avez plus de fichiers ou des noms d'onglets différents, vous devrez ajuster le code en conséquence.