VBA copier et insérer ligne

Résolu/Fermé
Signaler
-
 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

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
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41989 internautes nous ont dit merci ce mois-ci

Merci, j'ai utilisé ton idée de compter à partir de la dernière ligne et ça marche
est-ce qu'il serait possible de mettre les lignes copiées en couleur afin qu'elles soient identifiables rapidement?
Messages postés
575
Date d'inscription
vendredi 11 juillet 2014
Statut
Membre
Dernière intervention
30 mars 2016
28
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
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41989 internautes nous ont dit merci ce mois-ci

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
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41989 internautes nous ont dit merci ce mois-ci

Encore merci 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
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41989 internautes nous ont dit merci ce mois-ci