Fusionner des tableaux

Bonjour à toutes et à tous,

Je ne suis pas expert en VBA et aurais besoin d'une aide charitable.

Mon objectif :

Je possède trois tableaux sur 3feuilles différentes d'un classeur.

Les tableaux sont différents (en taille et en contenu) mais possèdent un certains nombre de colonnes dont le titre est commun (la colonne avec le code de chaque dossier par exemple).

Le but est d'obtenir automatiquement sur une nouvelle feuille un tableau contenant toutes les informations des 3 tableaux, avec tous les champs des autres tableaux et les informations de chaque dossier dans la bonne colonne.

Mon problème :

J'ai déjà pu coder une macro qui remplit cette fonction, mais elle est met énormément de temps à remplir sa fonction. J'aurais besoin d'un peu d'aide pour trouver une solution pour diminuer le temps d’exécution (raccourcir les boucles ou revoir complétement certaines parties du code).

Sub Bilan_global()
Dim ch_CF, ch_CF_RES, ch_RES As Integer 'nombre de champs de "CF brut", "CF associé RES" et "RES sans recup" (respectivement)
Dim ch_Bil As Integer 'nombre de champs de "Bilan global
Dim Doss_CF, Doss_CF_RES, Doss_RES, Doss_Bil As Integer 'nombre de dossiers de "CF brut", "CF associé RES" et "RES sans recup" (respectivement)
Dim i, j, k, m As Integer 'variables d'iterations
Dim champs_sup() As String
Set CF = Worksheets("CF brut"): Set RES = Worksheets("RES sans recup") 'Permet de donner un nom plus court aux feuilles

'Supression de la dernière feuille 'Bilan global' et création d'un nouvelle feuille vierge
Application.DisplayAlerts = False
Sheets("Bilan global").Delete
Application.DisplayAlerts = True
Worksheets.Add(Worksheets(Worksheets.Count)).Name = "Bilan global"

'Compte le nombre de champs de la feuille "CF brut"
ch_CF = 1
Sheets("CF brut").Select
While IsEmpty(Cells(1, ch_CF)) = False
    ch_CF = ch_CF + 1
Wend
ch_CF = ch_CF - 1

'Copie les champs de la feuille "CF brut" vers la feuille "Bilan global"
Sheets("CF brut").Select
Range(Cells(1, 1), Cells(1, ch_CF)).Select
Selection.Copy
Sheets("Bilan global").Select
Range(Cells(1, 1), Cells(1, ch_CF)).Select
ActiveSheet.Paste

'Compte le nombre de champs de la feuille "CF associé RES"
ch_CF_RES = 1
Sheets("CF associé RES").Select
While IsEmpty(Cells(1, ch_CF_RES)) = False
    ch_CF_RES = ch_CF_RES + 1
Wend
ch_CF_RES = ch_CF_RES - 1

'Copie les champs de la feuille "CF associé RES" vers la feuille "Bilan global"
Sheets("CF associé RES").Select
Range(Cells(1, 1), Cells(1, ch_CF_RES)).Select
Selection.Copy
Sheets("Bilan global").Select
Range(Cells(1, ch_CF + 1), Cells(1, ch_CF + ch_CF_RES)).Select
ActiveSheet.Paste

'Compte le nombre de champs de la feuille "RES sans recup"
ch_RES = 1
Sheets("RES sans recup").Select
While IsEmpty(Cells(1, ch_RES)) = False
    ch_RES = ch_RES + 1
Wend
ch_RES = ch_RES - 1

'Copie les champs de la feuille "CF associé RES" vers la feuille "Bilan global"
Sheets("RES sans recup").Select
Range(Cells(1, 1), Cells(1, ch_RES)).Select
Selection.Copy
Sheets("Bilan global").Select
Range(Cells(1, ch_CF + ch_CF_RES + 1), Cells(1, ch_CF + ch_CF_RES + ch_RES)).Select
ActiveSheet.Paste

'Supprime les champs en double
k = 0
Sheets("Bilan global").Select
For i = 1 To ch_CF + ch_CF_RES + ch_RES - k
    For j = i + 1 To ch_CF + ch_CF_RES + ch_RES - k
        If Cells(1, i) = Cells(1, j) Then
            Cells(1, j).Delete
            k = k + 1
        End If
    Next
Next

'Compte le nombre de champs de la feuille "Bilan global"
ch_Bil = 1
Sheets("Bilan global").Select
While IsEmpty(Cells(1, ch_Bil)) = False
    ch_Bil = ch_Bil + 1
Wend
ch_Bil = ch_Bil - 1

'Compte le nombre de dossier de la feuille "CF brut"
Doss_CF = 1
Sheets("CF brut").Select
While IsEmpty(Cells(Doss_CF, 3)) = False
    Doss_CF = Doss_CF + 1
Wend
Doss_CF = Doss_CF - 1

'Compte le nombre de dossier de la feuille "RES sans recup"
Doss_RES = 1
Sheets("RES sans recup").Select
While IsEmpty(Cells(Doss_RES, 3)) = False
    Doss_RES = Doss_RES + 1
Wend
Doss_RES = Doss_RES - 1

'Compte le nombre de dossier de la feuille "CF associé RES"
Doss_CF_RES = 1
Sheets("CF associé RES").Select
While IsEmpty(Cells(Doss_CF_RES, 3)) = False
    Doss_CF_RES = Doss_CF_RES + 1
Wend
Doss_CF_RES = Doss_CF_RES - 1

'Copie les dossiers de "CF brut"
For i = 1 To ch_Bil
    For j = 1 To ch_CF
        If Worksheets("Bilan global").Cells(1, i) = Worksheets("CF brut").Cells(1, j) Then
            Sheets("CF brut").Select
            Range(Cells(2, j), Cells(Doss_CF + 1, j)).Select
            Selection.Copy
            Sheets("Bilan global").Select
            Range(Cells(2, i), Cells(Doss_CF + 1, i)).Select
            ActiveSheet.Paste
        End If
    Next
Next

'Copie les dossiers de "RES sans recup"
For i = 1 To ch_Bil
    For j = 1 To ch_RES
        If Worksheets("Bilan global").Cells(1, i) = Worksheets("RES sans recup").Cells(1, j) Then
            Sheets("RES sans recup").Select
            Range(Cells(2, j), Cells(Doss_RES + 1, j)).Select
            Selection.Copy
            Sheets("Bilan global").Select
            Range(Cells(Doss_CF + 1, i), Cells(Doss_CF + Doss_RES + 1, i)).Select
            ActiveSheet.Paste
        End If
    Next
Next

'Complète les informations des projets de récupération de chaleur avec les informations liés à un réseau de chaleur
'lorsque le projet associe la récupération de chaleur à un projet de réseau de chaleur
'La bucle compare la colonee N° de convention associé de 'CF brut' à la colonne 'Code dossier' de 'RES + CF'
Doss_Bil = Doss_CF + Doss_RES
For i = 2 To Doss_Bil
    For j = 2 To Doss_CF_RES
        If Worksheets("Bilan global").Cells(i, 20) = Worksheets("CF associé RES").Cells(j, 3) Then
            For k = 1 To ch_Bil
                For m = 1 To ch_RES
                    If Worksheets("Bilan global").Cells(1, k) = Worksheets("CF associé RES").Cells(1, m) And IsEmpty(Cells(i, k)) = True Then
                        Sheets("CF associé RES").Select
                        Cells(j, m).Select
                        Selection.Copy
                        Sheets("Bilan global").Select
                        Cells(i, k).Select
                        ActiveSheet.Paste
                    End If
                Next
            Next
        End If
    Next
Next

End Sub

Merci d'avance pour votre aide

Guillaume

Rechercher des sujets similaires à "fusionner tableaux"