Créer un masterfile à partir de tables similaire d'autres Workbook

Bonjour la compagnie,

J'aimerais créer un master file qui reprend les données de tables d'autres workbook. Toutes les tables des workbooks sont similaires à l'exception du nombre de lignes. J'ai pour l'instant ce code-ci qui fonctionne, si ce n'est qu'il y a un problème au niveau de l'ajout. En effet, pour le moment il semblerait que les données importées sont "écrasées". Je pense que je dois louper quelque chose dans mon code mais je n'arrive pas à définir. Est-ce que quelqu'un aurait une idée?

Sub Update_masterfile()
'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
'========================
'    Some declarations
'========================
'a) Retrieve Target folder path. Where are the documents we need the information from?
    Dim Directory As String
    Directory = ThisWorkbook.Path & "\specificsubdirectoryname"
'b) What kind of files must we look for? Excel files so extension must be either .xls or xlsx.
    Dim ExtensionFile As String
    ExtensionFile = "*.xls*"
'c) The files we look are then named
    Dim Files As String
    Files = Dir(Directory & ExtensionFile)
    '==> This is only possible because of the star previous to the extension.
'd) Declare the loop object
    Dim wb As Workbook
'e) Data to extract
    Dim tbl As String
    Dim sname As String
    sname = "Sheet name" 'Always the same
    tbl = "tbl name" 'Always the same

'=======================
'     Looping process
'=======================
'First we clear data
If ThisWorkbook.Worksheets(sname).ListObjects(tbl).DataBodyRange Is Nothing Then
    GoTo Nextstep 'If there is no data, just avoid this step because it will result in an error
Else
ThisWorkbook.Worksheets(sname).ListObjects(tbl).DataBodyRange.Delete 'otherwise clear table
End If

Nextstep: 'That's where we get after in any case from above
'Loop through each Excel file in folder
Do While Files <> ""
    Set wb = Workbooks.Open(Filename:=Directory & Files)
    Dim wname As String
    wname = ActiveWorkbook.Name
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
'    'Appending data to MasterFile table
    'define rows in table to append
    Dim RC As Long
    RC = ThisWorkbook.Worksheets(sname).Range(tbl).Rows.Count
    'Copy Table
    Range(tbl).Copy ThisWorkbook.Worksheets(sname).Range(tbl).End(xlUp).Offset(1)
    MsgBox Range(tbl).Rows.Count & " " & wname
'    Application.CutCopyMode = False
    'Save and Close Workbook
      wb.Close SaveChanges:=True
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents
    'Get next file name
     Files = Dir
  Loop

'Reset Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Je suis presque persuadé que le problème se situe dans cette ligne précise

Range(tbl).Copy ThisWorkbook.Worksheets(sname).Range(tbl).End(xlUp).Offset(1)

ou alors j'aurais oublié une boucle quelque part?

Merci d'avance pour celles et ceux qui prennent le temps de lire et de répondre :)

Bonjour,

Essayer ceci

    'Copy Table
    With ThisWorkbook.Worksheets(sname).Range(tbl).ListObject
        Range(tbl).Copy .ListRows(.ListRows.Count).Range.Offset(1)
    End With

Bonjour,

Merci pour ta contribution. Cependant cela ne fonctionne pas. En réalité, avec cette partie de code, Excel va directement en mode Break et donc, contrairement au code que j'ai essayé auparavant (qui reste mauvais), il n'y a plus d'opérations de copier-coller.

Ah j'ai finalement réussi à résoudre le problème avec bêtement :

Range(tname).Copy

 ThisWorkbook.Worksheets(sname).Range(tname).Insert