Microsoft 365 Répartir le texte sur plusieurs cellules

[st007]

Bonjour,
Une question pour un planning :
Est-il possible d'étaler le résultat d'une formule sur les cellules adjascente contenant aussi une formule dont le résultat est "" provenant d'un sierreur(..;"")
L'idéal est de colorer la plage et centrer le texte sur cette plage.
Merci d'avance

 

[st007]

re,
Je prersévère, mais de petits soucis persistent et je ne vois pas comment m'en sortir.
Un coup d'oeil, une solution serait appréciée.
La fusion devrait se faire que par ligne et si on pouvait supprimer le message d'alerte de fusion ..
le code :

Sub Macro1()
'
Dim zone As Range
    Sheets("Planning").Copy After:=Sheets(2)
          For Each cell In Range("C5:AE35")
                If cell.Value <> "" Then
                  If zone Is Nothing Then
                     Set zone = cell
                  Else
                   Set zone = Application.Union(zone, cell)
                  End If
                End If
            Next
            zone.Interior.Color = RGB(255, 217, 102)
            zone.Font.Color = RGB(255, 0, 255)
            zone.MergeCells = True 'Select

End Sub

 

[dg62]

Bonjour,
Pour supprimer le message d'alerte

Application.DisplayAlerts=False en début de code

et Application.DisplayAlerts= True en fin de code

 

[st007]

Bonjour,
Pour supprimer le message d'alerte

Application.DisplayAlerts=False en début de code

et Application.DisplayAlerts= True en fin de code

Merci pour le message d'alerte

 

[dg62]

Re,
Une piste mais pas encore la solution.

Sub Macro1()
'
Dim zone As Range

Application.DisplayAlerts = False
    Sheets("Planning").Copy After:=Sheets(2)
          
          For Each cell In Range("C5:AE35")
                If cell.Value <> "" Then
            
                  If zone Is Nothing Then
                    
                        Set zone = cell
                    
                  Else
                
                        Set zone = Application.Union(cell, zone)
                        zone.Interior.Color = RGB(255, 217, 102)
                        zone.Font.Color = RGB(255, 0, 255)
                        zone.MergeCells = True
                        Set zone = Nothing
                  End If
                  
                End If
            Next
                           
          
            Application.DisplayAlerts = True
End Sub

 

[st007]

Sub Finaliser()
Dim c As Range
Sheets("Planning").Copy after:=Sheets(Sheets.Count)
Do
Application.DisplayAlerts = False
  With Sheets("Planning (2)")

    For Each c In .Range("C5:AE35")
      If c <> "" And c.Offset(, 1) <> "" Then Range(c, c.Offset(, 1)).Merge
           If c <> "" Then c.Interior.Color = RGB(255, 217, 102)
           If c <> "" Then c.Font.Color = RGB(255, 0, 255)

    Next c
  End With
Loop While MsgBox("Voulez-vous continuer la fusion ?", vbQuestion + vbYesNo + vbDefaultButton1) = vbYes
          
Application.DisplayAlerts = True

End Sub

J'en suis là, mais, le loop traite le soucis d'une plage >à 2 cellules
et la fusion devrait fusionner le site et les ---- qui suivent avec le nom du site
or, si j'ai "site" "------" "------" "site2" --- " "----" . le site2 disaparait évidement ...

 

[dg62]

Je n'ai plus le temps ce soir mais il serait interessant de combiner les deux procédures car je gère la succession des sites mais pas la succession des --------.

 

[dg62]

Bonjour le fil,

A tester

Sub Finaliser()
Dim c As Range
Dim DZone as String
Dim Fzone as String
Application.DisplayAlerts = False

Sheets("Planning").Copy after:=Sheets(2)


For Each c In Range("C5:AE35")
If c <> "" And c <> "------" Then dzone = c.Address
If c = "------" Then Fzone = c.Address
If c = "" And c.Offset(0, -1) = "------" Then
Range(dzone, Fzone).Merge
Range(dzone, Fzone).Interior.Color = RGB(255, 217, 102)
Range(dzone, Fzone).Font.Color = RGB(255, 0, 255)
End If
Next


Application.DisplayAlerts = True

End Sub

 

[st007]

Merci dg62 pour l'inspiration, au final, çà donne

Sub Finaliser2() ' Merci dg62

Dim c As Range
Dim DZone As String
Dim Fzone As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Planning").Copy after:=Sheets(2)
For Each c In Range("C5:AE35")
If c <> "" And c <> "------" Then DZone = c.Address
Fzone = c.Offset(, 1).Address
If c = "------" Then Fzone = c.Address
If c = "" Then GoTo prochain
Range(DZone, Fzone).Merge
Range(DZone, Fzone).Interior.Color = RGB(255, 217, 102)
Range(DZone, Fzone).Font.Color = RGB(255, 0, 255)
prochain:
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[dg62]

Bonjour St007
j'avais rallongé des plages mais je n'avais pas pensé aux antécédents dans mes tests.
Bon dimanche