Fusion dynamique des cellules dans une plage, Excel VBA

Fusion dynamique des cellules dans une plage, Excel VBA

Voici un code VBA détaillé qui permet de fusionner dynamiquement des cellules dans une plage en fonction des valeurs identiques. Le script détecte les valeurs répétées dans une colonne et fusionne automatiquement les cellules correspondantes. 

Code VBA : Fusion dynamique d’une plage 

Sub FusionPlageDynamique() 
    Dim ws As Worksheet 
    Dim derniereLigne As Long, derniereColonne As Long 
    Dim rng As Range, cellule As Range 
    Dim debutFusion As Range, finFusion As Range 
    Dim valeurActuelle As String 
    ' Définir la feuille de calcul sur laquelle l'opération sera effectuée 
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Modifier "Feuil1" par le nom réel de votre feuille 
    ' Trouver la dernière ligne et colonne utilisées 
    derniereLigne = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 
    derniereColonne = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 
    ' Boucler à travers chaque colonne dynamiquement 
    Dim col As Integer 
    For col = 1 To derniereColonne 
        Set rng = ws.Range(ws.Cells(2, col), ws.Cells(derniereLigne, col)) ' Supposons que la première ligne est l'en-tête 
        ' Initialiser le processus de fusion 
        Set debutFusion = rng.Cells(1) 
        valeurActuelle = debutFusion.Value 
        ' Boucler à travers chaque cellule de la colonne 
        For Each cellule In rng 
            If cellule.Row = debutFusion.Row Then GoTo SautIteration ' Ignorer la première ligne 
            ' Si la valeur est identique à la précédente, étendre la plage de fusion 
            If cellule.Value = valeurActuelle Then 
                Set finFusion = cellule 
            Else 
                ' Fusionner la plage précédente si elle contient plus d'une ligne 
                If debutFusion.Row <> finFusion.Row Then 
                    ws.Range(debutFusion, finFusion).Merge 
                    ws.Range(debutFusion, finFusion).HorizontalAlignment = xlCenter 
                    ws.Range(debutFusion, finFusion).VerticalAlignment = xlCenter 
                End If 
                ' Commencer une nouvelle séquence de fusion 
                Set debutFusion = cellule 
                valeurActuelle = cellule.Value 
            End If 
SautIteration: 
        Next cellule 
        ' Fusionner le dernier groupe restant 
        If debutFusion.Row <> finFusion.Row Then 
            ws.Range(debutFusion, finFusion).Merge 
            ws.Range(debutFusion, finFusion).HorizontalAlignment = xlCenter 
            ws.Range(debutFusion, finFusion).VerticalAlignment = xlCenter 
        End If 
    Next col 
    MsgBox "Fusion terminée avec succès !", vbInformation, "Fusion Complète" 
End Sub

Explication détaillée 

1. Sélection de la feuille de calcul 

• Le script commence par définir la feuille de travail sur laquelle l’opération doit être exécutée. 
• La ligne Set ws = ThisWorkbook.Sheets("Feuil1") permet d’assurer que le code s’exécute bien sur la bonne feuille. 

2. Détection des dernières lignes et colonnes utilisées 

• derniereLigne = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row permet de détecter la dernière ligne contenant des données dans la colonne A. 
• derniereColonne = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column identifie la dernière colonne utilisée. 

3. Boucle sur chaque colonne 

• La boucle For col = 1 To derniereColonne permet de traiter toutes les colonnes contenant des données. 

4. Initialisation des variables pour la fusion 

• debutFusion est défini comme la première cellule de la colonne. 
• valeurActuelle enregistre la valeur de debutFusion pour suivre les doublons. 

5. Boucle sur chaque cellule 

• Une boucle For Each parcourt chaque cellule de la colonne : For Each cellule In rng 
• Si la valeur de la cellule est identique à valeurActuelle, finFusionest mis à jour pour inclure cette cellule. 
• Si la valeur change, la plage précédente est fusionnée et un nouveau groupe commence. 

6. Fusion des cellules consécutives identiques 

• Le script fusionne uniquement si plusieurs lignes sont concernées :  

If debutFusion.Row <> finFusion.Row Then 
    ws.Range(debutFusion, finFusion).Merge 
    ws.Range(debutFusion, finFusion).HorizontalAlignment = xlCenter 
    ws.Range(debutFusion, finFusion).VerticalAlignment = xlCenter 
End If

Cette condition évite de fusionner des cellules isolées. 

7. Fusion finale pour le dernier groupe 

• Comme la boucle peut se terminer avant d’avoir fusionné le dernier groupe, une dernière vérification assure que toute la colonne est bien traitée. 

8. Notification à l’utilisateur 

• Un message apparaît à la fin pour informer que l’opération est terminée. 

Cas d’utilisation 

• Ce script est particulièrement utile pour formater des tableaux contenant des valeurs répétées. 
• Il fonctionne automatiquement sur plusieurs colonnes sans intervention manuelle. 
• Il est idéal pour la mise en page de rapports ou de tableaux bien structurés.