VBA copier et insérer ligne

Résolu
Bstn -  
 Maurice -
Bonjour, j'ai un petit soucis de programmation.

J'ai une ligne avec divers paramètre dont un chiffre en colonne H.
Je souhaiterai que si ce chiffre est égal a 6 je copie toute la ligne et je l'insère sur la ligne du dessous en décalant toutes les lignes d'un cran vers le bas.

J'espère avoir été clair et que quelqu'un pourra m'aider.
Cordialement

4 réponses

  1. Maurice
     
    Bonjour
    ou avec un truc comme ca 
    Sub InsertLigne()
Application.ScreenUpdating = False
Nlig = Range("A" & Rows.Count).End(xlUp).Row
   For L = Nlig To 2 Step -1
      If Cells(L, 8).Value = 6 Then
         Rows(L + 1).Insert Shift:=xlDown
         Rows(L).Copy
         Range("A" & L + 1).PasteSpecial xlPasteAll ' ou xlPasteValues
      End If
   Next
   With Application
      .CutCopyMode = False
      .ScreenUpdating = True
      .Goto [A1], True
   End With
End Sub

    A+
    Maurice
    1
    1. Bstn
       
      Merci, j'ai utilisé ton idée de compter à partir de la dernière ligne et ça marche
      0
    2. Bstn
       
      est-ce qu'il serait possible de mettre les lignes copiées en couleur afin qu'elles soient identifiables rapidement?
      0
  2. Theo.R Messages postés 585 Statut Membre 31
     
    Avec auto-calcul de la dernière ligne du tableau :

    Sub TEST()

    Dim DernLigne As Long
    DernLigne = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

    Dim NB6 As Long
    NB6 = WorksheetFunction.CountIf(Range("H:H"), "=6")

    For i = 1 To DernLigne + NB6

    If Range("H" & i).Value = "6" Then
    Rows(i & ":" & i).Select
    Selection.Copy
    Rows(i + 1 & ":" & i + 1).Select
    Selection.Insert Shift:=xlDown
    i = i + 1

    End If

    Next i

    Application.CutCopyMode = False
    Range("A1").Select

    End Sub
    1
  3. Maurice
     
    Bonjour

    Avec du jaune 
    Sub InsertLigne()
Application.ScreenUpdating = False
Nlig = Range("A" & Rows.Count).End(xlUp).Row
   For L = Nlig To 2 Step -1
      If Cells(L, 8).Value = 6 Then
         Rows(L + 1).Insert Shift:=xlDown
         Rows(L).Copy
         Range("A" & L + 1).PasteSpecial xlPasteAll ' ou xlPasteValues
         Rows(L + 1).Interior.ColorIndex = 19
      End If
   Next
   With Application
      .CutCopyMode = False
      .ScreenUpdating = True
      .Goto [A1], True
   End With
End Sub

    A+
    Maurice
    1
    1. Bstn
       
      Encore merci maurice!
      0
  4. Maurice
     
    Bonjour
    la touche final 
    Sub InsertLigne()
If MsgBox("Confirmez-vous ?", vbQuestion + vbYesNo, "Momo") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Nlig = Range("A" & Rows.Count).End(xlUp).Row
   For L = Nlig To 2 Step -1
      If Cells(L, 8).Value = 6 Then
         Rows(L + 1).Insert Shift:=xlDown
         Rows(L).Copy
         Range("A" & L + 1).PasteSpecial xlPasteAll ' ou xlPasteValues
         Rows(L + 1).Interior.ColorIndex = 19
      End If
   Next
   With Application
      .CutCopyMode = False
      .ScreenUpdating = True
      .Goto [A1], True
   End With
End Sub

    je pense que tu peux Valider

    A+
    Maurice
    1