Macro permet au texte de s'étendre sur colonnes suivantes

Bonjour,

je suis débutante dans les macros. Alors, il faut bien m'expliqué.

J'aimerais créer un macro qui permettrait à mon texte de la colonne A de s'étendre sur les colonnes suivantes. Je dois garder la colonne A à une petite largeur. Les lignes de chaque colonne contiennent des petites formules pour importer d'une autre feuille les informations changeantes d'un tableau croisé dynamique vers ma feuille en question.

Voici la formule: =TCD!D35

Précision: pour ce qui est des lignes de la colonne A qui contiennent du texte, les colonnes suivantes contiennent seulement la formule, mais il a rien d'importé

ex:......A.........B........C

1...................34......lire

2.. ...je dem

3...................46....macro

La cellule A2, la phrase est incomplet.

Que puis-je faire avec ça?

Voici un petit détail. Je sais pas si ça vous sera utile.

Je fais toujours une copie de ma feuille de formule nommé "modele" quand les informations de mon tableau croisé dynamique change.

Bonjour

Si tu ne peux pas augmenter la largeur de la colonne A

Augmente sa hauteur et opte pour une écriture verticale, ou avec un renvoi automatique à la ligne (voir dans las options du format de cellule)

Ce n'est pas vraiment ça que je voulais que ça fasse. Mais merci d'avoir pris du temps pour moi, Banzai64.

J'ai peut-être mal expliqué mon problème.

Les cellules de ma colonne A doit rester tel quel, que se soit pour la largeur ou la longueur . La grosseur du texte aussi ne doit pas changer. J'ai pensé aujourd'hui ce qui règlerait mon problème serait d'avoir un macro qui

fusionnerais mes colonnes A, B, C ensemble. Mais comment faire?

Si cela peut aidé, voici quelques informations. Comme je l'ai dit, mes cellules de la page "modèle" contiennent la formule d'écrit plus haut. J'ai créé un macro qui copie ma page "modèle". Après, elle copie les cellules avec les formules et elle fait un collage spécial "valeur et formats des nombres", pour que les informations dans les cellules deviennent du texte normale.

Alors comment pourrais-je dire qu'à cette ligne, quand il y a du texte dans la colonne "A", fusionne toi avec les autres cellules B et C?

S'il y a d'autres solutions gênez-vous pas à me le proposer.

merci de prendre le temps de m'aider.

Bonsoir

Cela veut dire que dans les colonnes B et C sont libres de toute information

Le mieux ce serait de joindre un fichier

Dans la page 1 ce que tu as et dans la page 2 ce que tu voudrais avoir

En attendant essayes

Option Explicit

Sub Fusionne()
Dim J As Long

  For J = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If Range("A" & J) <> "" Then
      Range("A" & J).Resize(1, 3).Merge
    End If
  Next J
End Sub

maguy a écrit :

Alors comment pourrais-je dire qu'à cette ligne, quand il y a du texte dans la colonne "A", fusionne toi avec les autres cellules B et C?

Cette ligne à une position fixe où elle va varier de position suivant l'execution d'une macro ?

Dans les autres cellules ce sera quoi comme contenu, des chiffres ou du texte également ?

Merci Lean de ton intérêt.

Je parle des lignes qui contiennent du texte dans la colonne A. Mais leur emplacement peut-être différent à cause de mon tableau croisé dynamique qui est sur un autre feuille, nomme TCD. Ca dépendant toujours de ce que j'affiche dans mon tableau croisé dynamique. Mais quand il a du texte sur certaines lignes de la colonne "A" de ma feuille "Modele", les autres colonnes des mème lignes il n"y a rien d'inscrit. Alors c'est pour cela que je pensais de les fusionner.

Banzai64 a écrit :

Bonsoir

Cela veut dire que dans les colonnes B et C sont libres de toute information

Le mieux ce serait de joindre un fichier

Dans la page 1 ce que tu as et dans la page 2 ce que tu voudrais avoir

En attendant essayes

Option Explicit

Sub Fusionne()
Dim J As Long

  For J = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If Range("A" & J) <> "" Then
      Range("A" & J).Resize(1, 3).Merge
    End If
  Next J
End Sub

Un fichier???

Comment cela se fait-il?

Tu sais j'en suis vraiment dans mes débuts avec tout ça.

Dans ce cas essayez le code suivant

Option Explicit

Sub Fusionne()
Dim J As Long

  For J = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If Range("B" & J) = "" Then
      Range("A" & J).Resize(1, 3).Merge
    End If
  Next J
End Sub
 

Pour joindre un fichier regardez en dessous du cadre où vous écrivez votre message.

Vous avez deux onglets, option ou ajouter des fichiers joints

Cliquez sur " ajouter des fichiers joints "

Cliquez sur parcourir et allez chercher votre fichier dans votre ordinateur

Cliquez ensuite sur le bouton " ajouter le fichier " juste à droite du bouton parcourir

Puis une fois le message fini d'être rédigé, cliquez sur Envoyer.

Bonjour Lean,

ton macro a l'air a fonctionner mais pas très bien dans mon cas.

J'ai remarqué que mes cases vide contiennent la valeur "0". Elle n'est pas visible à cause de la sélection d'affichage: Pas de zéro.

J'ai remplacer le: If Range("B" & J) = "0" Then

mais sans succès.

Je veux fusionner les cellules entre A12:A39, seulement s'il a du texte avec les colonnes B et C.

La colonne B contient des chiffres

La colonne C contient du texte et des chiffres.

j'aurais peut-être du écrire ces petits détails.

Je ne veux pas mettre le fichier sur internet. désolé.

Bonjour Banzai64,

j'ai essayé ton macro, mais sans succès.

Lean et toi, vous m'avez donné un macro semblable.

J'ai écris des renseignements supplémentaires à Lean.

Va les voirs, il te seront peut-être utile.

Un gros merci à vous deux pour votre aide, je l'apprécie beaucoup.

Bonjour Maguy, Banzai64

Maguy,

Nous reprennons à chaque fois le code d'origine de Banzai64 pour l'adapter donc il est normal qu'il soit le même à un pouillème près.

l'adaptation ci-dessous du code avec prise en compte des difficultés rencontrées.

Sub Fusionne()
Application.DisplayAlerts = False
Dim J As Long
For J = 12 To 39
If Range("B" & J) = "0" And Range("c" & J) = "0" Then
Range("A" & J).Resize(1, 3).Merge
else
End If
Next J
End Sub

Mille merci à Lean pour ta modification

et à Banzai64 pour ton code.

OUI.......ça marche.

J'aurais deux petite demandes:

J'aimerais inclure dans le code. Quand il a la valeur "0" dans la colonne "A" de ne pas faire la fusion.

et l'autre est que j'ai déjà écrit un code et je voudais incluse la votre.

_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 votre code modifié selon mes lignes et colonnes:

Je veux qu'il le fasse après la formation de ma nouvelle page.

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

A tester car je ne suis pas sûr que cela fonctionne correctement

Je n'ai pas pris le code entier pour éviter de devoir faire 15 copié-collé pour rien.

Sub Fusionne()
Application.DisplayAlerts = False
Dim J As Long
For J = 13 To 39
If Range("a" & j) = "0" Then GoTo 1
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Goto 1
For J = 13 To 39
If Range("a" & j) = "0" Then GoTo 1
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Goto 1
For J = 50 To 76
If Range("a" & j) = "0" Then GoTo 1
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Goto 1
1:End if
next
end sub

Et pour que les deux macros s'enchainent rajouter dans la première macro au dessus de end sub call Fusionne

Malheureusement ça ne fonctionne pas.

il dit qu'il a une erreur de compilation variable For déjà utilisé.

Sur le tableau le deuxième "For J = 13" est souligné.

Sub Fusionne()
Application.DisplayAlerts = False
Dim J As Long
For J = 13 To 39
If Range("A" & J) <> "0" Then
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
Range("O" & J).Resize(1, 6).Merge
Else
End If
End If
End If
Next J
For J = 50 To 76
If Range("A" & J) <> "0" Then
If Range("E" & J) = "0" And Range("F" & J) = "0" Then
Range("D" & J).Resize(1, 6).Merge
Else
End If
End If
Next J
End Sub
 

Répéter les boucles suivantes sous cette syntaxe là en pensant à changer les xx par les bons numéros de ligne et les bonnes colonnes

For J = xx To xx
If Range("A" & J) <> "0" Then
If Range("xx" & J) = "0" And Range("xx" & J) = "0" Then
Range("xx" & J).Resize(1, 6).Merge
Else
End If
End If
Next J

Bonsoir

A essayer

Sub maguy() '

' maguy Macro
'
' Touche de raccourci du clavierÊ: Option+Cmd+s
'

  Sheets("Modele").Copy Before:=Sheets(1)
  Sheets(1).Name = Range("I6")
  Range("D4:T224").Copy
  Range("D4").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  Range("E14:E224").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").TextToColumns Destination:=Range("P14"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
                FieldInfo:=Array(1, 1)

  Fusionne

  Range("T24").Select
End Sub

Sub Fusionne()
Dim J As Long, K As Long

  Application.DisplayAlerts = False
  For K = 13 To 198 Step 37
    For J = K To K + 26
      If Range("A" & J) <> "0" Then
        If Range("E" & J) = "0" And Range("F" & J) = "0" Then
          Range("D" & J).Resize(1, 6).Merge
        End If
        If Range("P" & J) = "0" And Range("Q" & J) = "0" Then
          Range("O" & J).Resize(1, 6).Merge
        End If
      End If
    Next J
  Next K
End Sub

Sub Fusionne()

Dim J As Long, K As Long

Application.DisplayAlerts = False

For K = 13 To 198 Step 37

For J = K To K + 26

If Range("D" & J) <> "0" Then

If Range("E" & J) = "0" And Range("F" & J) = "0" Then

Range("D" & J).Resize(1, 6).Merge

End If

_Ici_ ( If Range("P" & J) = "0" And Range("Q" & J) = "0" Then

Range("O" & J).Resize(1, 6).Merge )

End If

End If

Next J

Next K

End Sub

Bonjour

Ton code marche super Bien, mais sur la feuille direct. J'ai changer seulement le "A" pour le "D"

désolé. Le "A" n'était qu'un exemple. Je veux que la colonne "O" fasse la même chose pour la partie mentionné entre parenthèse.

If Range("O" & J) <> "0" Then

If Range("P" & J) = "0" And Range("P" & J) = "0" Then

Range("O" & J).Resize(1, 6).Merge

Il me reste juste cela à régler. J'ai essayé moi même, mais sans succès. Je suis trop une débutante.

En passant, si je met ton code dans mon code maguy ça ne fonctionne pas.

Bonjour

Sinon on n'a pas finit

Ok. Je joint une copie de ma feuille "modele". J'ai remplacé les textes par des "x" et les chiffres par des "1".

Voici un résumé de ce que je veux faire: Je veux voir les textes au complet qui sont marqué de "x" en gras des la colonnes "D" et "O", cela sans toucher au largeur et longueur des colonnes. Les lignes concernées sont de 13 à 39, 50 à 76, 87 à 113, 124 à 150, 161 à 187, 198 à 224. Donc, la solution est la fusion comme j'avais déjà dit, mais seulement au texte des colonnes concernées. (D et O). Comme je l'ai déjà mentionné les cases vides ont comme valeur "0" caché. Je veux fusionner les 6 colonnes des tableaux ensembles aux lignes appropriées.

(Ne pas oublier que d'une copie à l'autre que l'emplacements des textes peuvent changer à cause de mon tableau croisé dynamique.)

Si possible, je veux joindre le code dans mon code maguy, qui est copié plus haut dans l'un message d'avant. Je veux que d'un seul clique que tout se fasse, avec le bouton que j'ai créé dans le dossier. (Sinon je créerai un autre bouton dans ma feuille "modele".)

En passant, j'ai un Mac. C'est peut-être une information importante.

Encore merci. Je ne reviens pas de la vitesse que vous répondez. C'est tellement gentil.

Les prochaines fois je vais toujours joindre un fichier. Je ne niaiserai plus avec ça. Désolé pour tout.

Je vais prendre de l'expérience c'est certains, car je tripe au bout avec Excel. Je me suis découvert une vrai passion.

Bonjour

Regardes si cela convient

Bonsoir Banzai64,

Tout est numéro un. Je suis tellement contente.

Tu est vraiment bon dans ce que tu fais. En plus, tu en fais profiter d'autre.

C'est très généreux de ta part.

Un gros merci.

Je voudrais remercier Lean pour tout le temps que tu as pris pour m'aider.

C'était trés gentil ta part.

Merci