Insertion de lignes selon le choix

bcharef

XLDnaute Accro
Bonsoir à toutes et à tous.

Je me trouve devant un problème dont la solution ne sera réalisée que par le VBA d'aprés mes connaissances.

Le problème s'explique comme suit:

La colonne C de l'exemple ci-joints porte sur des listes de validation.

Exemple :

En C26

Si, je dois faire le choix de plus d'une, je me retrouve dans l'obligation d'insérer une ligne en collant les données de la plage A26:D26, aprés confirmation de l'insertion.

En C28

Je me retrouve dans l'obligation d'insérer deux lignes portant les données de A28:D28, après confirmation une après une.

Le fichier ci-joint porte des éclaircissements ainsi que l'objectif recherché

Il est utile de porter à votre connaissance que je un ignare en matiére de VBA.

Salutations distinguées.

BCharef
 

Pièces jointes

  • InsertLignes.xls
    19.5 KB · Affichages: 74

JNP

XLDnaute Barbatruc
Re : Insertion de lignes selon le choix

Bonjour BCharef :),
Vois si le fichier en retour te convient. Il te suffit d'un double-clic sur la cellule A de la ligne que tu veux dupliquer ;).
Bon WE :cool:
PS : Des "salutations amicales" seraient plus agréables que des "salutations distinguées" :rolleyes:...
 

Pièces jointes

  • InsertLignes(1).xls
    49 KB · Affichages: 69

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Bonjour JNP,
Bonjour à toutes et à tous.

J'ai le grand plaisir de vous remercier au temps précieux que vous m'aviez accorder pour la solution.

Est-il possible, une fois que je double clic sur la cellule A16, et après l'autorisation de l'insertion, la ligne insérée soit la ligne 17, elle affichera les données de la plage A16 : D16.

Amicalement.

BCharef
 

JNP

XLDnaute Barbatruc
Re : Insertion de lignes selon le choix

Re :),
Si tu veux dire par là copier la ligne précedente, il suffit de changer dans mon code
Code:
Range("AColler").Copy Cells(Ligne, 1)
par
Code:
Rows(Ligne - 1).Copy Cells(Ligne, 1)
Bon WE :cool:
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

La substitution recommandée du code, m'a permis de constater le résultat recherché.

Sans abuser de votre temps, comment faire pour appliquer ce code sur l'ensemble des feuille d'un classeur.

Je vous remercie encore une fois.

Cordialement.

BCharef
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

J'ai pu porter une modification de code comme suit:

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Par :

Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Puis supprimer le code de Worksheet Feuil1 dans ThisWorkbook.

A ce moment tout va bien, mais lorsque je double clic sur une feuille du classeur, le code s'exécute mais, il insère les données de la feuil1.

A cet effet, j'ai le plaisir de vous demander les corrections nécessaire que, je dois prendre.

Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 1 Then Exit Sub
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion")
If I = vbCancel Then Exit Sub
Ligne = Target.Row + 1
Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AColler").Copy Cells(Ligne, 1)
Union(Cells(Ligne, 3), Cells(Ligne, 5), Cells(Ligne, 6)).ClearContents
Cancel = True
Target.Offset(1, 0).Select
End Sub

Cordialement.

BCharef
 

JNP

XLDnaute Barbatruc
Re : Insertion de lignes selon le choix

Re :),
En supprimant mon code de la Feuil1 et en copiant celui-ci dans ThisWorkbook, ça devrait le faire
Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 1 Then Exit Sub
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion")
If I = vbCancel Then Exit Sub
Ligne = Target.Row + 1
With Sh
.Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(Ligne - 1).Copy .Cells(Ligne, 1)
Union(.Cells(Ligne, 3), .Cells(Ligne, 5), .Cells(Ligne, 6)).ClearContents
Cancel = True
Target.Offset(1, 0).Select
End With
End Sub
A + :cool:
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

Oui, exactement.

La correction portée sur le nouveau code ce fameux With Sh et le (.) point .

Voulez-bien m'expliquer ce code :
Code:
Union(.Cells(Ligne, 3), .Cells(Ligne, 5), .Cells(Ligne, 6)).ClearContents


Amicalement.

BCharef
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.


En attente toujours d'une explication correcte.

Et, sauf erreur, le code

Code:
Union(.Cells(Ligne, 3), .Cells(Ligne, 5), .Cells(Ligne, 6)).ClearContents

permet de ne pas coller les données portées dans la colonne 3 (C); 5 (E) & 6 (F).

Amicalement.

Bcharef
 
Dernière édition:

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

C'est plus juste, effacer que de ne pas coller .

Juste, une autre question, une fois que la ligne est insérée, je souhaiterais qu'il affiche un zéro dans les deux colonnes 5 (E) et 6 (F) .

Comment faire?

Amicalement.

BCharef
 
Dernière édition:

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

Sans abuser de votre temps.

Voilà, j'ai appliqué le code conformément à la structure du classeur, mais c'est lourd lorsqu'il commence à afficher les Zéros.

Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 4 Then Exit Sub
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion")
If I = vbCancel Then Exit Sub
Ligne = Target.Row + 1
With Sh
.Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(Ligne - 1).Copy .Cells(Ligne, 1)
.Cells(Ligne, 6) = 0
.Cells(Ligne, 7) = 0
.Cells(Ligne, 8) = 0
.Cells(Ligne, 9) = 0
.Cells(Ligne, 10) = 0
.Cells(Ligne, 11) = 0
.Cells(Ligne, 12) = 0
Union(.Cells(Ligne, 4), .Cells(Ligne, 5)).ClearContents
Cancel = True
Target.Offset(1, 0).Select
End With
End Sub

En attente d'une amélioration du présent code.

Amicalement.

BCharef
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

Effectivement, l'affichage des Zéros rend l'exécution lourde.

Je pense, qu'il est nécessaire de porter des corrections sur le code:

Code:
.Cells(Ligne, 6) = 0
.Cells(Ligne, 7) = 0
.Cells(Ligne, 8) = 0
.Cells(Ligne, 9) = 0
.Cells(Ligne, 10) = 0
.Cells(Ligne, 11) = 0
.Cells(Ligne, 12) = 0

Il est à noter que je suis nulle en matiére de VBA.

Amicalement.

BCharef