Sub Defusionne()
Dim i&
Application.ScreenUpdating = False
With Feuil1 'CodeName
With .Range("A1", .UsedRange)
For i = 7 To .Rows.Count
With .Cells(i, 2).MergeArea
If .Count > 1 Then .UnMerge: .Value = .Cells(1)
End With
With .Cells(i, 3).MergeArea
If .Count > 1 Then .UnMerge: .Value = .Cells(1)
End With
Next
End With
End With
End Sub
selectionner la celluleJe voudrais savoir si il est possible de défusionner une cellule et de recopier automatiquement dans les 2 cellules la même chose
Salut JOB75.Bonsoir Moreno076,
S'il n'y a que 2 cellules à défusionner ça ne vaut pas le coup d'utiliser le VBA, s'il y en a beaucoup par contre :
Pas difficile de compléter les bordures à la fin si nécessaire.VB:Sub Defusionne() Dim i& Application.ScreenUpdating = False With Feuil1 'CodeName With .Range("A1", .UsedRange) For i = 7 To .Rows.Count With .Cells(i, 2).MergeArea If .Count > 1 Then .UnMerge: .Value = .Cells(1) End With With .Cells(i, 3).MergeArea If .Count > 1 Then .UnMerge: .Value = .Cells(1) End With Next End With End With End Sub
A+
Merci mais c'est bon j'ai opté pour la solution de Job75Bonsou®
selectionner la cellule
puis séquence de touches
Alt L U U L
puis
ctrl-B
en pourra avantageusement utiliser l'enrgistreur de macro :
Sub Macro1()
' Macro1 Macro
Selection.UnMerge
Selection.FillDown
End Sub
Sub Defusionne()
Dim i&
Application.ScreenUpdating = False
With Feuil1 'CodeName
With .Range("A1", .UsedRange)
For i = 7 To .Rows.Count
With .Cells(i, 2).MergeArea
If Not .Font.Bold And .Count > 1 Then .UnMerge: .Value = .Cells(1)
End With
With .Cells(i, 3).MergeArea
If Not .Font.Bold And .Count > 1 Then .UnMerge: .Value = .Cells(1)
End With
Next
End With
End With
End Sub
Merci JOB75 c'est celle là qui me convient !!! Merci beaucoup et bonnes fêtes.On peut aussi utiliser sur votre fichier la propriété Bold (gras) :
VB:Sub Defusionne() Dim i& Application.ScreenUpdating = False With Feuil1 'CodeName With .Range("A1", .UsedRange) For i = 7 To .Rows.Count With .Cells(i, 2).MergeArea If Not .Font.Bold And .Count > 1 Then .UnMerge: .Value = .Cells(1) End With With .Cells(i, 3).MergeArea If Not .Font.Bold And .Count > 1 Then .UnMerge: .Value = .Cells(1) End With Next End With End With End Sub