XL 2016 Fusionner des cellules

[jymathieu]

Bonjour,
Le document ci-joint doit être protéger afin d'éviter que les utilisateurs qui vont avoir ce fichier ne puissent pas supprimer ou modifier les titres de A3 en N3.
Ci-joint un tableau dans lequel je voudrais pourvoir fusionner les cellules des colonnes A jusque E.
Comme on le voit, dans les colonnes F4 à M12 les utilisateurs vont entrer des données différentes.
Dans les colonnes A4 a E4, les utilisateurs rentrent une seule donnée par cellule.
Ensuite A13 à E13, une seule donnée par cellule et de F13 a M15 différentes données.
Et ainsi de suite comme le montre le fichier
Je voudrais pouvoir fusionner les cellules de A13 à A15, B13 à A15, etc...
Chaque fois que j'ai une donnée suivi de blanc dans les cellules de A à E, les fusionner.
Merci d'avance

 

[herve62]

Bonjour tous
@jymathieu
Ci joint un 1er jet , je propose déclenchement car je ne vois pas autre ?
On doit se baser sur les dernières saisies sinon beaucoup plus complexe
Les cellules A3 N3 sont protégées , les autres sont libres ( feuille protégée sans MdP)

 

[job75]

Bonjour jymathieu,

Voyez le fichier joint et la macro affectée au bouton :

Sub Fusion()
Dim col As Range, a As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si aucune SpecialCell
With Sheets("Form")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("A4:E" & .Range("H" & .Rows.Count).End(xlUp).Row)
        If .Row < 4 Then Exit Sub
        .UnMerge 'défusionne
        For Each col In .Columns
            For Each a In col.SpecialCells(xlCellTypeBlanks).Areas
                If a(0).Row > 3 Then Union(a(0), a).Merge 'fusionne
        Next a, col
    End With
End With
End Sub

A+

 

[jymathieu]

Bonjour jymathieu,

Voyez le fichier joint et la macro affectée au bouton :

Sub Fusion()
Dim col As Range, a As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si aucune SpecialCell
With Sheets("Form")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("A4:E" & .Range("H" & .Rows.Count).End(xlUp).Row)
        If .Row < 4 Then Exit Sub
        .UnMerge 'défusionne
        For Each col In .Columns
            For Each a In col.SpecialCells(xlCellTypeBlanks).Areas
                If a(0).Row > 3 Then Union(a(0), a).Merge 'fusionne
        Next a, col
    End With
End With
End Sub

A+

Bonjour jymathieu,

Voyez le fichier joint et la macro affectée au bouton :

Sub Fusion()
Dim col As Range, a As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si aucune SpecialCell
With Sheets("Form")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("A4:E" & .Range("H" & .Rows.Count).End(xlUp).Row)
        If .Row < 4 Then Exit Sub
        .UnMerge 'défusionne
        For Each col In .Columns
            For Each a In col.SpecialCells(xlCellTypeBlanks).Areas
                If a(0).Row > 3 Then Union(a(0), a).Merge 'fusionne
        Next a, col
    End With
End With
End Sub

A+

Merci cela fonctionne bien mais je voudrais, si c'est possible, ôter la protection du fichier tourner la macro pour fusionner et reprotéger le fichier.
Est-ce possible