Fusion de table VBA
doulab_sy
Messages postés
9
Statut
Membre
-
doulab_sy Messages postés 9 Statut Membre -
doulab_sy Messages postés 9 Statut Membre -
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
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
3 réponses
-
Bonjour,
ci-dessous code pour fusionner vos 2 feuilles dans Feuil4
--
Dim nb_col_base2015 As Long
With Sheets("base2015").UsedRange 'plage utiliséé
nb_col_base2015 = .Columns.Count 'nombre de colonnes utilisées de base2015
Sheets("Feuil4").Cells.Resize(.Rows.Count, .Columns.Count).Value = .Cells.Value
End With
With Sheets("base2016").UsedRange 'plage utiliséé
Sheets("Feuil4").Cells.Resize(.Rows.Count, .Columns.Count).Offset(, nb_col_base2015).Value = .Cells.Value
End With
-
Je n'ai pas spécialement étudié votre code car je suis parti de votre demande :
feuille 1 = Base 2015
feuille 2 = Base 2016
feuille 4 = Base 2015 + Base 2016
Mon code sert juste à fusionner côte à côte les 2 bases en supposant qu'elle soient de structure identique.
Si votre code traite un décalage de structure, vous devez apporter les précisions nécessaires en fournissant un extrait des bases 2015 et 2016. -
Dans votre code, vous effectuez des opérations supplémentaires à la fusion à partir de votre feuille "Calcul".
Mettez mon code au début et travaillez ensuite seulement au niveau des feuilles : "Feuil4" et "Calcul", la feuille "BASE20152016" n'a a priori plus de raison d'y figurer.
