2 lignes sur une ligne et supprimer une ligne sur 2

Résolu/Fermé
ray23bulls Messages postés 5 Date d'inscription dimanche 25 avril 2021 Statut Membre Dernière intervention 27 avril 2021 - 25 avril 2021 à 11:54
ray23bulls Messages postés 5 Date d'inscription dimanche 25 avril 2021 Statut Membre Dernière intervention 27 avril 2021 - 27 avril 2021 à 19:07
Bonjour,
Dans un tableau j'ai 60 lignes. Je voudrais regrouper 2 lignes sur seule ligne et supprimer une ligne sur deux du coup.
Merci pour votre aide.

4 réponses

cs_Le Pivert Messages postés 7860 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 2 décembre 2022 723
25 avril 2021 à 15:40
Bonjour,

En vba

Faire Alt F11 sur la feuille concernée pour accéder au module de la feuille.

se déclenche au double clic sur la cellule concernée

Mettre ce code:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then 'adapter la colonne
ActiveCell = Target.Value & vbLf & Range("A" & Target.Row + 1).Value '2 lignes dans la même cellule
 Rows(Target.Row + 1 & ":" & Target.Row + 1).Delete Shift:=xlUp 'supression ligne
  End If
End Sub


voilà


0
ray23bulls Messages postés 5 Date d'inscription dimanche 25 avril 2021 Statut Membre Dernière intervention 27 avril 2021
25 avril 2021 à 18:42
Bonsoir,
Merci pour votre aide.
Mais ce n'est pas exactement ce que je souhaite.
Pour mieux me faire comprendre, je vous joins un fichier exemple. https://www.cjoint.com/c/KDzqNRoH2W2
L'onglet feuil1 est mon document (je n'ai mis que 4 lignes mais j'en ai jusqu'à 60), l'onglet feuil2 est ce que je souhaiterais.
Merci pour votre aide.
Cordialement
0
cs_Le Pivert Messages postés 7860 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 2 décembre 2022 723
25 avril 2021 à 19:05
se déclenche au double clic:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then 'adapter la colonne
Worksheets("feuil 1").Range("A" & Target.Row + 1 & ":D" & Target.Row + 1).Copy _
    Destination:=Worksheets("feuil 1").Range("E" & Target.Row)
    Rows(Target.Row + 1 & ":" & Target.Row + 1).Delete Shift:=xlUp 'supression ligne
End If
End Sub



@+ Le Pivert
0
ray23bulls Messages postés 5 Date d'inscription dimanche 25 avril 2021 Statut Membre Dernière intervention 27 avril 2021
25 avril 2021 à 19:26
Merci!
Si j'ai bien compris, je dois double cliquer sur chaque ligne que je garde?
Bien cordialement
0
ray23bulls Messages postés 5 Date d'inscription dimanche 25 avril 2021 Statut Membre Dernière intervention 27 avril 2021
25 avril 2021 à 19:42
De plus, y a t il possibilité d'enregistrer cela comme une macro?
PS : je ne suis pas du tout expert....
Merci
0
cs_Le Pivert Messages postés 7860 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 2 décembre 2022 723
25 avril 2021 à 20:58
Voilà un exemple:

https://www.cjoint.com/c/KDzs5q2Grp1

@+ Le Pivert
0
ray23bulls Messages postés 5 Date d'inscription dimanche 25 avril 2021 Statut Membre Dernière intervention 27 avril 2021 > cs_Le Pivert Messages postés 7860 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 2 décembre 2022
27 avril 2021 à 19:07
Merci mille fois.
0