Macro permet à un texte de s'étendre sur les colonnes suivantes.

Bonjour,

Si tu pouvais nous mettre un exemple sans éléments personnels mais avec la structure des données sur https://www.cjoint.com/ puis nous mettre le lien généré ici ce serait plus facile de t'aider.

Bonjour gbinforme,

Merci de ton intérêt. J'ai avancé beaucoup avec mon problème.
La solution était la fusion des cellules. Le deuxiéme code en bas est bon.
Mais j'aurais trois petites questions pour toi ou quelqu'un d'autre.

1-Voici ce que j'aimerais inclure en plus dans le code: Quand il y a la valeur "0" dans la colonne "E" et "O", de ne pas faire la fusion même si les autre colonne ont aussi la valeur "0". (Les cases vides comporte des valeurs "0" qui sont cachées). Voir le deuxième code.

2-L'autre est que j'ai déjà écrit un code et je voudrais incluse le deuxième dedans.
Je veux qu'il le fasse après la formation de ma nouvelle page. Voir le premier code.

3-Le dernier serait-il possible que le deuxième code soit plus petit.

Précision:Ma première question du début était exacte sauf pour les lettre des colonnes. Ce n'était que des exemples. Mes vrais lettres pour les colonne sont inscrit dans mon deuxième code.

-voici mon code:

Sub maguy() '

' maguy Macro
'
' Touche de raccourci du clavierÊ: Option+Cmd+s
'
Sheets("Modele").Select
Sheets("Modele").Copy Before:=Sheets(1)
Sheets(1).Name = Range("I6")
Range("D4:T224").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("E14:T224").Select
ActiveWindow.SmallScroll Down:=-164
Range("I18").Select
Range("E14:E224").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("E14"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Range("P14:P150").Select
Selection.TextToColumns Destination:=Range("P14"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Range("T24").Select

End Sub

_]Voici le deuxième code:

Sub Fusionne()
Application.DisplayAlerts = False
Dim J As Long
For J = 13 To 39
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 13 To 39
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 50 To 76
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 50 To 76
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 87 To 113
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 87 To 113
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 124 To 150
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 124 To 150
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 161 To 187
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 161 To 187
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 198 To 224
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Else
End If
Next J
For J = 198 To 224
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Else
End If
Next J
End Sub

Bonjour,

1-C'est intégré en gras dans le code

2-Il te faut mettre dans ton premier code :

call Fusionne

3-Le deuxième code est plus petit...

Sub Fusionne()
Application.DisplayAlerts = False
Dim J As Long, p As Integer
Dim dpl(), fpl()
dpl = Array(13, 50, 87, 124, 161, 198)
fpl = Array(39, 76, 113, 150, 187, 224)
p = 0
For J = dpl(0) To fpl(UBound(fpl))
    If Range("E" & J) = 0 And Range("F" & J) = 0 _
        And Range("E" & J) + Range("O" & J) > 0 Then
            Range("D" & J).Resize(1, 6).Merge
    End If
    If Range("P" & J) = "0" And Range("Q" & J) = "0" _
        And Range("E" & J) + Range("O" & J) > 0 Then
            Range("O" & J).Resize(1, 6).Merge
    End If
    If J = fpl(p) And J < fpl(UBound(fpl)) Then
        p = p + 1
        J = dpl(p) - 1
    End If
Next J
End Sub

Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer. Antoine de Saint-Exupéry