Fusion de table VBA

Bonjour,
je souhaiterai fusionner deux bases cote à cote. J'ai réussi via un code VBA à copier coller les deux bases avec chacune sa feuille. Ce que je voudrai moi c'est de les avoir les deux sur une seule feuille ( base2016 !! base2015).
Est ce que quelqu'un pourrait m'aider.
En espérant être compris.

image de la base2015


voici une image du résultat que j'attends après avoir réussi à merger les deux bases



image de la base2016


voici mon code si cela pourrait vous aider:

Public Sub Modalites()

Dim i, j As Integer

finBASE20152016 = Worksheets("BASE20152016").Cells(Rows.Count, "A").End(xlUp).Row

j = 1

For i = 1 To finBASE20152016

If Worksheets("BASE20152016").Cells(i, 1).Value <> Worksheets("BASE20152016").Cells(i + 1, 1).Value Then
Worksheets("Calcul").Cells(j, 1).Value = Worksheets("BASE20152016").Cells(i + 1, 1).Value
Worksheets("Calcul").Cells(j, 2).Value = i + 1
j = j + 1
End If

Next i

fincalcul = Worksheets("Calcul").Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To fincalcul
Worksheets("Calcul").Cells(i, 3).Value = Worksheets("Calcul").Cells(i + 1, 2) - Worksheets("Calcul").Cells(i, 2)
Next i

Dim finreference, fincolonne As Integer
Dim k, m, l As Integer

finreference = Worksheets("Feuil4").Cells(Rows.Count, "A").End(xlUp).Row
fincolonne = Worksheets("BASE20152016").Cells(1, Columns.Count).End(xlToLeft).Column

For i = 1 To fincalcul
For j = 1 To finreference
If Worksheets("BASE20152016").Cells(j, 1).Value = Worksheets("Calcul").Cells(i, 1).Value Then
For m = 2 To fincolonne
l = j
For k = Worksheets("Calcul").Cells(i, 2).Value To Worksheets("Calcul").Cells(i + 1, 2).Value - 1
Worksheets("Feuil4").Cells(l + 2, m - 1).Value = Worksheets("BASE20152016").Cells(k, m).Value
l = l + 1
Next k
Next m
End If
Next j
Next i

Worksheets("feuil4").Cells(i, 18).Value = Worksheets("feuil4").Cells(i, 10).Value / Worksheets("feuil4").Cells(i, 2) - 1
For i = 8 To finligne
If Worksheets("feui4").Cells(i, 2).Value <> Worksheets("feuil4").Cells(i + 1, 1).Value Then


Worksheets("feuil4").Cells(i, 18).Value = Worksheets("feuil4").Cells(i, 10).Value / Worksheets("feuil4").Cells(i, 2) - 1

End If
Next i


End Sub