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

Fermé

Maguy - 8 juin 2013 à 05:43
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 11 juin 2013 à 21:58

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?

A voir également:

Macro permet à un texte de s'étendre sur les colonnes suivantes.
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Etendre ecran pc - Guide
Mettre un texte en majuscule - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur

3 réponses

Réponse 1 / 3

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 686
9 juin 2013 à 10:17

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.

Réponse 2 / 3

Maguy
Modifié par Maguy le 9/06/2013 à 22:35

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

Réponse 3 / 3

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 686
Modifié par gbinforme le 11/06/2013 à 21:59

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

Discussions similaires

Trouver le mot réellement écrit en lettres capitales PIX

Formule Excel : "SI" une cellule contient un mot, alors ?

ou sont les bananes ?

avantages et inconvénients du téléphone portable

copie de texte

Discussions similaires

Newsletters