XL 2013 [Résolu] grâce à vous tous]Ajouter des cellules sur une partie de ligne

bellenm

XLDnaute Impliqué
Bonjour à tous amis d'excel,

J'ai chercher mais en vain j'ai bien trouver l'une ou l'autre discussion sur ce forum parlant du sujet mais pas comme le mien.
Voilà j'ai une feuille ou j'aimerais ajouter des cellules pour ne pas parler d'une partie de ligne.
si je suis sur la ligne 6 il faudrait insérer des cellules en "A6, B6, C6, D6, E6, F6 et G6" sans bien sûr modifier ce qui se trouve dans les colonnes suivantes. de plus en même temps que l'insertion l'ajout du contenu de la cellule se trouvant sur la ligne supérieur de la colonne"D" donc la cellule "D5" dans ce cas-ci.

Tout se trouve sur le fichier joint.

Une discussion était lancée auparavant sur le sujet mais je n'y suis mal exprimé et je ne sais pas comment l'enlever ici!

Merci pour votre savoir que vous partager via le forum et aides les personnes comme moi.

Marc
 

Pièces jointes

  • ajout ligne.xlsx
    16.7 KB · Affichages: 35

eriiic

XLDnaute Barbatruc
Bonjour,

dans le module de la feuille :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 2 Then
    Cancel = True
    Cells(Target.Row, 1).Resize(, 7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(Target.Row - 1, 4) = Cells(Target.Row - 2, 4)
    End If
End Sub
un double-clic en B insère les cellules.
eric
 

Papou-net

XLDnaute Barbatruc
Bonsoir bellenm, Eric, le Forum,

Voici une solution qui insère une ligne (également avec un double-clic) et qui effectue le tri quand la ligne du tableau est renseignée (c'est la cerise sur le gâteau).

Les explications sont sur la feuille.

Cordialement.
 

Pièces jointes

  • Copie de ajout ligne.xlsm
    25.7 KB · Affichages: 24

bellenm

XLDnaute Impliqué
Bonjour Eric , Papounet, le forum,


Vos deux formules fonctionne parfaitement le plus apporté par Papou-net est le tri!

Mais pourquoi lorsque j'ajoute un nom avec comme classement un joueur qui devrait se retrouver en 1 er position le tri n'est pas correct?

Si non je suis épaté je ne croyais pas ma demande possible :)

Marc
 

Papou-net

XLDnaute Barbatruc
Bonjour Eric , Papounet, le forum,


Vos deux formules fonctionne parfaitement le plus apporté par Papou-net est le tri!

Mais pourquoi lorsque j'ajoute un nom avec comme classement un joueur qui devrait se retrouver en 1 er position le tri n'est pas correct?

Si non je suis épaté je ne croyais pas ma demande possible :)

Marc
Bonjour Marc,
Salut Eric,,

Marc, peux-tu joindre un exemple du problème?

Pour info:
- Le tri respecte l'ordre que tu as indiqué dans ta demande: colonne D, puis colonne C et enfin colonne B. Peut-être faut-il revoir la logique de tri?
- La macro recopie également les formules (qui ne sont pas intégrées lors de l'insertion des cellules)

A +

Cordialement.
 

bellenm

XLDnaute Impliqué
Autant pour moi il s'est classer mais devant un nouveau club donc c'est juste.

Comment je fais pour exporteer ces formules sur mon bon fichier

Il y a du code a mettre dans le Worksheet de la feuil1 qui dans l'autre classeur est la feuil3
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row > 1 And Target.Column < 8 Then
  Call Inserer(Target.Row)
  Cancel = True
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column < 8 Then
  If (Range("B" & Target.Row) > "") * (Range("D" & Target.Row) > "") * (Range("E" & Target.Row) > "") Then
    Application.EnableEvents = False
    Call Tri20(Target.Row)
    Application.EnableEvents = True
  End If
End If
End Sub
sur ce code je ne vois rien à modifier je pense et puis il y a dans Module 1
Code:
Sub Inserer(Lg As Long)
With Feuil1 ' ici je met alors Feuil3
  .Range("A" & Lg & ":G" & Lg).Insert
  .Range("C" & Lg - 1).Copy .Range("C" & Lg)
  .Range("D" & Lg - 1).Copy .Range("D" & Lg)
  .Range("F" & Lg - 1).Copy .Range("F" & Lg)
End With
End Sub

Sub Tri20(Lg As Long)
Dim LgDeb As Long, LgFin As Long

LgDeb = IIf(Lg >= 11, Lg - 9, 2)
LgFin = Lg + 10
With Feuil1.Sort ' ici aussi Feuil3
  .SortFields.Clear
  .SortFields.Add Key:=Range("D" & LgDeb & ":D" & LgFin) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  .SortFields.Add Key:=Range("C" & LgDeb & ":C" & LgFin) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  .SortFields.Add Key:=Range("B" & LgDeb & ":B" & LgFin) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  .SetRange Range("A" & LgDeb & ":G" & LgFin)
  .Header = xlGuess
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
End With
End Sub
et c'est tout comme adaptation?

C'est super Papou-net cela fonctionne selon mon attente super!! ;)

Question subsidiaire:
Dans ce même fichier au lieu d'ajouter je voudrais modifier une cellule et trie à la fin de la même manière mais sans rajouter de cellule juste pouvoir les modifier!

Merci pour temps

Marc
 

Papou-net

XLDnaute Barbatruc
RE

Bravo, tu as tout compris Marc.

En effet, dans le code de la feuille il n'y a rien à modifier puisque les deux procédures sont attachées à cette même feuille. Son nom n'y est donc pas cité.

Dans le code de Module1, il faut bien entendu remplacer "Feuil1" par le CodeName de ta feuille, soit "Feuil3".

Quant au troisième point, pas de modification de code à prévoir non plus. En effet, la procédure de tri étant lancée par l'événement Change de la feuille, elle sera automatiquement exécutée par la modification d'une cellule. Pour rappel, Tri20 n'est lancée que si une des cellules des colonnes B, D ou E est modifiée et qu'aucune n'est vide:

If (Range("B" & Target.Row) > "") * (Range("D" & Target.Row) > "") * (Range("E" & Target.Row) > "") Then

Bonne journée.

Cordialement.
 

bellenm

XLDnaute Impliqué
Papou-net tu es trop fort là mon fichier est devenus super, grace à vous tous j'espère n'oublier personne
Merci donc à CISCO qui m'a aider il y a déjà 2 ans pour la base et le reste aussi, récemment à Pinzi, Jocelyn, Eric et toi Papou-net.

Je ne saurais jamais vous remercier assez, mais je fait la pub pour vous autour de moi.

Bon 15 août à vous tous et amis d'excel.

Marc
 

Discussions similaires

Statistiques des forums

Discussions
311 708
Messages
2 081 750
Membres
101 812
dernier inscrit
trufu