Macro pour décaler cellules vers la droite

lolo62000

XLDnaute Junior
Bonjour,

j'ai un fichier Excel dans lequel apparaissent en colonne E, les valeurs suivantes:
Dentaire
Santé
CGS
... et d'autres données.
Je souhaiterais faire rouler une macro, afin que lorsque la valeur de la cellule en colonne E est différente de "Dentaire", "Santé" ou "CGS", les cellules de la ligne, à partir de la colonne E se décalent vers la droite.
Exemple: Si valeur en E5 = x, alors E5,E6,E7,E8.... se décalent de +1 vers la droite.
J'avais un morceau de code, qui ne fonctionne pas:

Sub MoveRightColumnE()
Dim I As Integer
For I = [E65000].End(xlUp).Row To 1 Step -1
If Cells(I, 5).Find("SANTE") Is Nothing Or _
Cells(I, 5).Find("DENTAIRE") Is Nothing Or _
Cells(I, 5).Find("CGS") Is Nothing Then Rows(I).End(xlToRight).Column 1
Next I

End Sub


Pouvez-vous m'aider à l'améliorer afin que ma macro fonctionne.

Merci et bonne journée.
Laurent.
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : Macro pour décaler cellules vers la droite

Bonsoir lolo62000.


En l'absence de votre classeur, un essai à adapter à votre situation.​


ℝOGER2327
#6983


Mercredi 18 As 141 (Saint Chambernac, pauvriseur - fête Suprême Quarte)
30 Brumaire An CCXXII, 8,2629h - rouleau
2013-W47-3T19:49:52Z
 

Pièces jointes

  • Classeur20.xlsm
    23.8 KB · Affichages: 79
  • Classeur20.xlsm
    23.8 KB · Affichages: 78
  • Classeur20.xlsm
    23.8 KB · Affichages: 89
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : Macro pour décaler cellules vers la droite

Re...


Excellent ℝOGER2327
C'est tout à fait ce dont j'avais besoin.
Je vais tenter de l'appliquer à mon exemple, et te reviens si j'ai toujours des soucis.
Merci, bonne soirée.
Voici une version peut-être plus lisible et plus facile à adapter :​
VB:
Sub TOTO()
Dim i&, j&, k&, cl()
  cl = Array(Empty, "A", "B", "C")
  k = UBound(cl)
  For i = 1 To [CLEF].Rows.Count
    With [CLEF].Cells(i, 1)
      For j = 0 To k
        If .Value = cl(j) Then Exit For
      Next
      If j > k Then
        Range(.Cells, [Data].Cells(i, [Data].Columns.Count)).Cut Destination:=.Offset(, 1)
      End If
    End With
  Next
End Sub


Bonne nuit.


ℝOGER2327
#6984


Mercredi 18 As 141 (Saint Chambernac, pauvriseur - fête Suprême Quarte)
30 Brumaire An CCXXII, 9,2225h - rouleau
2013-W47-3T22:08:03Z
 

lolo62000

XLDnaute Junior
Re : Macro pour décaler cellules vers la droite

Rebonjour ℝOGER2327.

La première macro que tu m'as proposé fonctionne bien.
Cependant, j'ai deux questions:
Est-il possible de faire le même genre de macro, mais cette fois ci, avec =A, ou =B, ou =C.
J'ai essayé de modifier en remplaçant <> par =, mais là je ne sais pas pourquoi, ça ne fonctionne pas.

Autre question, je viens de me rendre compte que certaines valeurs A, B ou C, ne sont pas forcément toutes dans la même colonne. Peut-on programmer, pour aligner les valeurs sur une même colonne.
Par exemple:
décaler A situé en F4 (plus les autres cellules à droite de F4), pour le mettre en I4....
décaler B situé en G5 (plus les autres cellules à droite de G5), , pour le mettre en I5....

Merci pour ton aide, très très appreciée.
Bonne soirée.
Laurent.
 

Pièces jointes

  • Classeur20.xlsm
    24.6 KB · Affichages: 97
  • Classeur20.xlsm
    24.6 KB · Affichages: 99
  • Classeur20.xlsm
    24.6 KB · Affichages: 111

lolo62000

XLDnaute Junior
Re : Macro pour décaler cellules vers la droite

Salut,
c'est encore moi.
En fait, après avoir réétudié mon cas, je pense que j'aurais juste besoin de pouvoir faire rouler la macro, à l'inverse, c'est à dire, si dans les colonnes on trouve ces valeurs là ("SANTE", "DENTAIRE", "CGS"), alors on décale vers la droite.
Ci-dessous, ce que je pensais modifier pour que ça fonctionne, mais en vain:

Sub TOT5O()
Dim i&, j&, k&, cl()
cl = Array(Empty, "SANTE", "DENTAIRE", "CGS")
k = UBound(cl)
For i = 1 To [CLEF].Rows.Count
With [CLEF].Cells(i, 1)
For j = 0 To k
If .Value <> cl(j) Then Exit For
Next
If j > k Then
Range(.Cells, [Data].Cells(i, [Data].Columns.Count)).Cut Destination:=.Offset(, 1)
End If
End With
Next
End Sub

En modifiant donc le code, j'aurais juste à créér plusieurs CLEF dans mon gestionnaire de noms, pour décaler une colonne à la fois. En gros si je me cale sur la colonne I, alors je créé une clef pour décaler de 1 vers la droite si je trouve ces valeurs. Colonne H, je décale de 2, colonne G, je décale de 3, etc....
Il ne reste plus qu'à codifier à l'envers par contre! =(
C'est possible?
Merci encore.
 

ROGER2327

XLDnaute Barbatruc
Re : Macro pour décaler cellules vers la droite

Suite...


Nouveau problème, nouvelle solution :​
VB:
Sub TOTO()
Dim i&, j&, k&, n&, p&, q&, cl()
  cl = Array("A", "B", "C")
  n = UBound(cl)
  p = [CLEF].Columns.Count
  q = [Data].Columns.Count - [CLEF].Column + [Data].Column
  For i = 1 To [CLEF].Rows.Count
  For j = 1 To p
    With [CLEF].Cells(i, j)
      For k = 0 To n
        If .Value = cl(k) Then Exit For
      Next
      If k <= n Then .Cells.Resize(, q - j + 1).Cut Destination:=.Offset(, p - j + 1)
    End With
  Next j, i
End Sub

Variante équivalente :​
VB:
Sub TOTO()
Dim i&, j&, p&, q&
  p = [CLEF].Columns.Count
  q = [Data].Columns.Count - [CLEF].Column + [Data].Column
  For i = 1 To [CLEF].Rows.Count
  For j = 1 To p
    With [CLEF].Cells(i, j)
      If .Value = "A" Or .Value = "B" Or .Value = "C" Then .Cells.Resize(, q - j + 1).Cut Destination:=.Offset(, p - j + 1)
    End With
  Next j, i
End Sub


Bonne nuit.


ℝOGER2327
#6989


Vendredi 20 As 141 (Saint Olibrius, augure - fête Suprême Quarte)
2 Frimaire An CCXXII, 0,8848h - turnep
2013-W47-5T02:07:24Z
 

Pièces jointes

  • Classeur21.xlsm
    27.1 KB · Affichages: 62
  • Classeur21.xlsm
    27.1 KB · Affichages: 71
  • Classeur21.xlsm
    27.1 KB · Affichages: 68

lolo62000

XLDnaute Junior
Re : Macro pour décaler cellules vers la droite

Salut,
excellent, tout fonctionne parfaitement.
Une toute dernière petite chose.
Dans ma colonne C, j'ai soit des noms de personnes, soit des valeurs numériques.
Comment faire pour que si en colonne C, la valeur de la cellule est numérique, alors décaler le tout jusque la colonne G
J'avais pour une autre raison ce genre de macro, mais à la place de supprimer la ligne, il faudrait commander un décalage vers la droite, de la colonne C à la colonne G.

Dim Lg&, Plg
Lg = Range("C65536").End(xlUp).Row
Set Plg = Range("C8:C" & Lg).SpecialCells(xlTextValues, 2)
Plg.EntireRow.Delete

Après ça tout sera correct! =)
Merci.
 
Dernière édition:

Discussions similaires

Réponses
1
Affichages
248
Réponses
0
Affichages
154

Membres actuellement en ligne

Statistiques des forums

Discussions
312 248
Messages
2 086 595
Membres
103 250
dernier inscrit
keks974