inserer lignes Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
k
kamellias
Membre habitué
Membre habitué
Messages : 108
Appréciation reçue : 1
Inscrit le : 10 février 2017
Version d'Excel : 2010

Message par kamellias » 2 janvier 2019, 03:57

Bonsoir,

Je souhaiterai avoir aide sur le cas suivant s'il vous plait

dans l'exemple en fichier joint je voudrais grace a une macro vba : dans la Colonne F si il a deux numero inserer la meme lignes de donnees en ajoutant le deuxieme numero

Pour etre plus précis le fichier joint avant et après

Merci
Classeur1.xlsx
(10.44 Kio) Téléchargé 2 fois
Avatar du membre
curulis57
Membre impliqué
Membre impliqué
Messages : 2'826
Appréciations reçues : 90
Inscrit le : 4 janvier 2016
Version d'Excel : 2013 FR

Message par curulis57 » 2 janvier 2019, 04:46

Salut Kamellias,

- un double-clic n'importe où pour traiter le fichier ;
- si une valeur en [F] entr dans les conditions, le traitement est appliqué à la ligne concernée.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Cancel = True
Application.EnableEvents = False
'
For x = Range("A" & Rows.Count).End(xlUp).Row To 4 Step -1
    If InStr(Trim(Range("F" & x - 1).Value), " ") > 0 Then
        Rows(x).Insert shift:=xlDown
        Range("A" & x & ":F" & x).Value = Range("A" & x - 1 & ":F" & x - 1).Value
        Range("F" & x).Value = Split(Range("F" & x - 1).Value, Chr(32))(1)
        Range("F" & x - 1).Value = Split(Range("F" & x - 1).Value, Chr(32))(0)
    End If
Next
'
Application.EnableEvents = True
'
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iRow%
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("F:F")) Is Nothing Then
    If Target.Count = 1 And Target <> "" Then
        iRow = Target.Row
        If InStr(Trim(Range("F" & iRow).Value), " ") > 0 Then
            Rows(iRow + 1).Insert shift:=xlDown
            Range("A" & iRow + 1 & ":F" & iRow + 1).Value = Range("A" & iRow & ":F" & iRow).Value
            Range("F" & iRow + 1).Value = Split(Range("F" & iRow).Value, Chr(32))(1)
            Range("F" & iRow).Value = Split(Range("F" & iRow).Value, Chr(32))(0)
        End If
    End If
End If
'
Application.EnableEvents = True
'
End Sub
A tester, comme on dit...

8-)
A+
Kamellias.xlsm
(21.1 Kio) Téléchargé 7 fois
k
kamellias
Membre habitué
Membre habitué
Messages : 108
Appréciation reçue : 1
Inscrit le : 10 février 2017
Version d'Excel : 2010

Message par kamellias » 2 janvier 2019, 05:09

Je te remercie curulis57

C'EST SUPER ! CA FONCTIONNE COMME JE LE SOUHAITE
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message