Insertion décalage de cellules

Le 03/01/2019 à 16:44

Bonjour à tous,

Je reviens à nouveau vers vous à propos de la fonction "insertion décalage de cellules".

J'aurais vraiment besoin de cette fonction, et non d'insérer une ligne.

Je joins un fichier de modèle pour être plus précis. c'est un tableau très simple.

Je souhaiterais que :

Si B8 non vide => alors insertion de cellules (et non insertion d'une ligne complète) de la colonne A à la colonne F sous la ligne 8 (donc au-dessus de la ligne "TOTAL") ayant le même format que la ligne 8 vide (c'est-à-dire le même format que les lignes 2 à 8). Puis à nouveau si B9 (cellule qui vient de se créer) non vide => alors insertion de cellules de la même manière.

Voilà, j'espère avoir été clair dans mon explication, et si quelqu'un peut m'aider, je le remercie grandement par avance.

Eric

6insert-cellules.zip (10.83 Ko)
Le 03/01/2019 à 16:50

bonjour,

Je ne comprend pas ce qui te gêne dans le fait d'insérer une ligne entière (Ce qui est vrai est BEAUCOUP plus simple)

Tu aurais des données dans les colonnes suivante dans ton cas réel ???

Girodo,

Le 03/01/2019 à 17:07

Salut blackmalkmus,

salut Girodo,

... peut-être y a-t-il d'autres tableaux à droite de celui-ci ?

Code dans le module VBA de 'Modele'. Le fichier passe en XLSM, évidemment...

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iRow%
'
Application.EnableEvents = False
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("B" & iRow - 1)) Is Nothing Then
    If Target <> "" Then
        Range("A" & iRow & ":F" & iRow).Insert shift:=xlDown
        Range("D" & iRow + 1).FormulaLocal = "=SOMME(D2:D" & iRow & ")"
        Range("E" & iRow + 1).FormulaLocal = "=SOMME(E2:E" & iRow & ")"
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

4insert-cellules.xlsm (17.30 Ko)
Le 03/01/2019 à 17:16

Bonjour à tous les 2 et un grand merci pour la réactivité

C'est exactement ça : il y a des choses à droite du tableau dans le cas réel.

Je regarde vite le résultat du codage et reviens vers vous.

Encore merci !

Le 15/01/2019 à 16:19

Bonjour curulis57 et bonjour Girodo,

Je me permets de revenir vers vous. La macro correspond à ce que je souhaitais, mais j’ai 2 problèmes :

1- J’ai essayé d’adapter la macro à mon « fichier réel » et ça ne fonctionne pas, car mon besoin est en réalité un peu plus complexe (désolé , j’aurais dû joindre dès le départ mon fichier réel). Je joins donc mon fichier réel à ce message. Mon besoin serait le suivant :

Si B24 non vide => alors insertion de cellules (et non insertion d'une ligne complète) de la colonne A à la colonne I sous la ligne 24 (donc au-dessus de la ligne "TOTAL") ayant le même format que la ligne 24 vide. Puis à nouveau si B25 (cellule qui vient de se créer) non vide => alors insertion de cellules de la même manière.

Puis idem si B32 non vide => alors insertion de cellules (et non insertion d'une ligne complète) de la colonne A à la colonne I sous la ligne 32 (donc au-dessus de la ligne "TOTAL") ayant le même format que la ligne 32 vide. Puis à nouveau si B33 (cellule qui vient de se créer) non vide => alors insertion de cellules de la même manière.

Puis idem si B40 non vide, puis idem toutes les 8 lignes jusqu’à B136, c’est-à-dire avec B48, B56, B64, B72, B80, B88, B96, B104, B112, B120, B128 et B136.

2- Il y a d’autres macros dans mon fichier réel. Il y a notamment une autre macro sur cette feuille, qui fait conflit avec la macro que vous m’avez proposée (apparemment conflit au niveau de « Private Sub Worksheet_Change(ByVal Target As Range) ».

La macro est la suivante :

Private Sub Worksheet_Change(ByVal Target As Range)

'permet de remonter les infos de la feuille Modele à la feuille Recap

If Not Intersect(Target, Range("L9")) Is Nothing Then

Dim Nom As String, Num As Long, adresse As Range

Nom = ActiveSheet.Name

Num = ActiveSheet.Range("C9").Value

Set adresse = Sheets("Recap_dossiers").Range("C:C").Cells.Find(Num)

Sheets("Recap_dossiers").Range("E" & adresse.Row).Value = Sheets(Nom).Range("L9").Value

End If

End Sub

=> Comment faire pour que les 2 macros fonctionnent ?

Par avance un grand merci pour votre retour

4insert-cellules-v2.xlsm (35.83 Ko)
Le 15/01/2019 à 19:57

Salut Blackmalkmus,

rien de compliqué : je suppose que tu as deux procédures Sub Change() End Sub l'une au-dessus de l'autre ?

Les codes doivent être intégrés dans une seule Sub, bien évidemment!

La situation de départ de chaque mois est bien celle montrée sur ton modèle, donc ?

  • faut-il vérifier la validité de la date encodée (janvier à mars ?) ?
  • sont-elles d'office encodées chronologiquement ou faut-il éventuellement trier ?
  • faut-il inscrire les première et dernières dans les cases bleues ?

Bref, toutes sortes de petits détails auxquels tu devrais penser pour automatiser un max, si possible...

A+

Le 15/01/2019 à 20:39

Salut Curulis 57,

Ok j'ai bien compris pour le 1er point : j'intégrerai les 2 codages dans Sub Change() End Sub.

Réponse à tes questions : non pas de vérification des dates encodées, pas de tri chronologique (les dates seront saisies manuellement chronologiquement), et pas besoin d'inscrire des dates dans les cellules surlignées en bleu.

Mon besoin est juste d'insérer-décaler une nouvelle ligne au-dessus de chaque ligne "TOTAL" dès lors que cette ligne fait l'objet d'une saisie (c'est-à-dire exactement la macro que tu m'avais proposée, mais qui se répète toutes les 8 lignes).

J'espère être clair et ne pas embrouiller...

Merci d'avance !

Le 15/01/2019 à 23:02

Salut Blackmalkmus,

ainsi ?

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iTRow%, iRowUp%
Dim Nom$, Num As Long, adresse As Range
'
Application.EnableEvents = False
'
iTRow = Target.Row
iRowUp = Target.End(xlUp).Row
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    If Target <> "" And Target.Offset(1, -1) = "TOTAL" Then
        Range("A" & iTRow + 1 & ":I" & iTRow + 1).Insert shift:=xlDown
        Range("E" & iTRow + 2).FormulaLocal = "=SOMME(E" & iRowUp & ":E" & iTRow & ")"
        Range("F" & iTRow + 2).FormulaLocal = "=SOMME(F" & iRowUp & ":F" & iTRow & ")"
    End If
End If

If Not Intersect(Target, Range("L9")) Is Nothing Then
    On Error Resume Next
    With Worksheets("Recap_dossiers")
        .Range("E" & .Range("C:C").Find(what:=Format(Range("C9").Value, "00" & " " & "0" & " " & "00000" & " " & "0"), lookat:=xlWhole, LookIn:=xlValues).Row).Value = Range("C9").Value
    End With
    On Error GoTo 0
End If
'
Application.EnableEvents = True
'
End Sub

A+

Le 16/01/2019 à 13:40

Bonjour Curulis,

La macro est super, merci beacoup

J'ai juste un problème et une question.

Mon problème : il y un bug avec

If Target <> "" And Target.Offset(1, -1) = "TOTAL" Then

quand je veux copier-coller des dates en colonne B (par exemple je saisis une date en B18 puis je copie-colle cette date en B19 et B20) ou si je décide d'effacer des dates après coup en colonne B (par exemple je saisis une date en B18, puis je saisis une date en B19, puis j'efface ces 2 dates).

Penses-tu qu'il y ait une solution ? Sinon, ce n'est pas si grave

Et ma question : est-ce que le codage :

If Not Intersect(Target, Range("L9")) Is Nothing Then

On Error Resume Next

With Worksheets("Recap_dossiers")

.Range("E" & .Range("C:C").Find(what:=Format(Range("C9").Value, "00" & " " & "0" & " " & "00000" & " " & "0"), lookat:=xlWhole, LookIn:=xlValues).Row).Value = Range("C9").Value

End With

On Error GoTo 0

End If

'

Application.EnableEvents = True

remplace le codage :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("L9")) Is Nothing Then

Dim Nom As String, Num As Long, adresse As Range

Nom = ActiveSheet.Name

Num = ActiveSheet.Range("C9").Value

Set adresse = Sheets("Recap_dossiers").Range("C:C").Cells.Find(Num)

Sheets("Recap_dossiers").Range("E" & adresse.Row).Value = Sheets(Nom).Range("L9").Value

End If

End Sub

Merci par avance de ton retour et bonne journée

Le 16/01/2019 à 14:34

Salut Blackmalkmus,

le bug est normal puisque le code ne prévoit le changement que d'UNE cellule à la fois.

Je regarde ça dès que j'ai 2' devant moi.

As-tu d'autres surprises de fonctionnement à me renseigner ?

Ta question : oui, ce code remplace l'autre et fonctionne très bien ici. Teste !

A+

Le 16/01/2019 à 17:19

1- Ok super merci !

2- Ah bah mince, ça ne fonctionne pas de mon côté...

Cette macro sert à incrémenter automatiquement le contenu de la cellule L9 de l'onglet "Modele" vers la colonne E d'un autre onglet (Recap_dossiers).

L'onglet Recap_dossiers est un tableau avec des noms de clients en colonne A.

A chaque saisie d'un nouveau client en colonne A, une macro duplique l'onglet "Modele" et lui donne le nom du client.

Par ailleurs, dans mon fichier, la cellule L9 contient une formule. C'est peut-être la présence d'une formule en L9 dans mon fichier qui fait que ça ne fonctionne pas ?

Le 16/01/2019 à 19:11

Salut Black,

Effectivement, un changement de valeur sur formule n'est pas pris en compte (d'après ce que je sais) par VBA : encore une con... monstrueuse de Microsoft.

... comme quoi, procurer un fichier complet avec des infos correctes, hein, hein ?

(phrases auto-censurées...)

Bon, cela dit entre parenthèses, bien sûr (ne le prends pas pour toi en particulier! ) , UN FICHIER REEL dépouillé de ses infos confidentielles accompagné d'infos exhaustives serait le bienvenu !

Il y a toujours moyen de s'en sortir et dans ce dernier cas, il doit bien y avoir sur ce forum un crack de la formule en goguette qui trouvera une belle solution... non ?

A+

Le 16/01/2019 à 19:43

Tu as complètement raison sur tous les points !

Le 23/01/2019 à 13:19

Bonjour Curulis57,

Je me permets de revenir vers toi à propos de ta macro.

Aurais-tu une solution pour que la macro fonctionne si plusieurs cellules sont modifiées en même temps ?

Avec la macro actuelle, si on souhaite supprimer des données (de B18 en F24 par exemple), il faut supprimer les données cellule par cellule, ce qui est un peu embêtant… (même chose pour des copier-coller sur plusieurs cellules).

Merci d'avance

Rechercher des sujets similaires à "insertion decalage"