Superposition de tableaux

Sub Fusion()
'Attention : le fichier de la feuille F2 doit être ouvert
Dim F1 As Worksheet, F2 As Worksheet, d As Object, c As Range, sup As Range
Set F1 = ThisWorkbook.Sheets("PISTOR SPUR BIODIS - Table 1")
Set F2 = Workbooks("INVENTAIRE SOURCE TEST.xlsx").Sheets("PISTOR-SPUR")
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Fusion")
  .Cells.Clear
  F1.UsedRange.EntireRow.Copy .[A1]
  F2.UsedRange.EntireRow.Copy .Cells(F1.UsedRange.Rows.Count + 1, 1)
  Set d = CreateObject("Scripting.dictionary")
  For Each c In Intersect(.[A:A], .UsedRange)
    If c = "" Or d.Exists(c.Value) Then _
      Set sup = Union(c, IIf(sup Is Nothing, c, sup))
    d(c.Value) = ""
  Next
  If Not sup Is Nothing Then sup.EntireRow.Delete
  .Columns.AutoFit 'ajustement automatique
End With
End Sub

Sub Fusion()
Dim chemin$, Wb As Workbook, w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
chemin = ThisWorkbook.Path & "\"
'---ouvre le 2ème fichier---
Set Wb = Workbooks.Open(chemin & "INVENTAIRE SOURCE TEST.xlsx")
With ThisWorkbook
  '---enregistre sous .xlsx---
  .SaveAs chemin & "Fusion.xlsx", 51
  '---ajoute les feuilles du 2ème fichier---
  For Each w In Wb.Worksheets
    w.Copy After:=.Sheets(.Sheets.Count)
  Next
  .Sheets(1).Delete
  .Save
  '---fermeture des fichiers---
  Wb.Close
  If Workbooks.Count = 1 Then Application.Quit Else .Close
End With
End Sub

Sub Fusion_Etape1()
Dim chemin$, fichier$, fich$
chemin = ThisWorkbook.Path & "\"
fichier = "Fusion.xlsx"
fich = ThisWorkbook.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.SaveAs chemin & fichier, 51
Workbooks.Open chemin & fich
Application.Run "'" & fich & "'!Lance"
ThisWorkbook.Close
End Sub

Sub Lance()
Application.OnTime Now, "Fusion_Etape2"
End Sub

Sub Fusion_Etape2()
Dim chemin$, fichier$, n1%, Wb As Workbook, n2%, n%
chemin = ThisWorkbook.Path & "\"
fichier = "Fusion.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---ouvre le 1er fichier---
Workbooks.Open chemin & fichier
n1 = ThisWorkbook.Sheets.Count
'---ouvre le 2ème fichier---
Set Wb = Workbooks.Open(chemin & "INVENTAIRE SOURCE TEST.xlsx")
n2 = Wb.Sheets.Count
'---ajoute les feuilles du 2ème fichier dans le 1er---
With Workbooks(fichier)
  For n = 1 To n2
    Wb.Sheets(n).Copy After:=.Sheets(.Sheets.Count)
  Next
  .Sheets("Fusion des fichiers").Delete
  n = .Sheets.Count
  '---fermeture des fichiers---
  .Close True
  Wb.Close
End With
Application.ScreenUpdating = True
'---test de vérification---
If n = n1 + n2 - 1 Then MsgBox "Fusion réussie, voyez le fichier '" & fichier & "'..."
End Sub

'---modification des liens---
.ChangeLink chemin & Wb.Name, fichier

'---tri alphabétique des onglets---
  For p = 1 To n
    For q = p + 1 To n
      If .Sheets(q).Name < .Sheets(p).Name Then .Sheets(q).Move Before:=.Sheets(p)
    Next q
  Next p
  .Sheets(1).Activate

'---suppression des feuilles du 2ème fichier faisant doublon---
  For p = Wb.Sheets.Count To 1 Step -1
    For q = 1 To n1
      If UCase(Wb.Sheets(p).Name) = UCase(.Sheets(q).Name) _
        Then Wb.Sheets(p).Delete
    Next q
  Next p
  n2 = Wb.Sheets.Count

Sub Fusion()
Dim chemin$, fichier$, fich$, fichformat%, n1%, Wb As Workbook, p%, q%, n2%, n%
chemin = ThisWorkbook.Path & "\"
fichier = "Fusion.xlsx"
fich = ThisWorkbook.Name
fichformat = ThisWorkbook.FileFormat
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.SaveAs chemin & fichier, 51
ThisWorkbook.SaveAs chemin & fich, fichformat '56 ou 52
'---rouvre le fichier Fusion---
Workbooks.Open chemin & fichier
n1 = ThisWorkbook.Sheets.Count
'---ouvre le 2ème fichier---
Set Wb = Workbooks.Open(chemin & "INVENTAIRE SOURCE TEST.xlsx")
With Workbooks(fichier)
  '---suppression des feuilles du 2ème fichier faisant doublon---
  For p = Wb.Sheets.Count To 1 Step -1
    For q = 1 To n1
      If UCase(Wb.Sheets(p).Name) = UCase(.Sheets(q).Name) _
        Then Wb.Sheets(p).Delete
    Next q
  Next p
  n2 = Wb.Sheets.Count
  '---ajoute les feuilles du 2ème fichier dans le 1er---
  For n = 1 To n2
    Wb.Sheets(n).Copy After:=.Sheets(.Sheets.Count)
  Next n
  .Sheets("Fusion des fichiers").Delete
  n = .Sheets.Count
  '---modification des liens---
  .ChangeLink chemin & Wb.Name, fichier
  '---tri alphabétique des onglets---
  For p = 1 To n
    For q = p + 1 To n
      If .Sheets(q).Name < .Sheets(p).Name Then .Sheets(q).Move Before:=.Sheets(p)
    Next q
  Next p
  .Sheets(1).Activate
  '---fermeture des fichiers---
  .Close True
  Wb.Close False
End With
Application.ScreenUpdating = True
'---test de vérification---
If n = n1 + n2 - 1 Then MsgBox "Fusion réussie, voyez le fichier '" & fichier & "'..."
End Sub