VBA copier et insérer ligne
Résolu
Bstn
-
Maurice -
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
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
A voir également:
- Insérer ligne vba
- Insérer video powerpoint - Guide
- Partager photos en ligne - Guide
- Insérer signature word - Guide
- Insérer liste déroulante excel - Guide
- Insérer sommaire word - Guide
4 réponses
Bonjour
ou avec un truc comme ca
A+
Maurice
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
Bstn
Merci, j'ai utilisé ton idée de compter à partir de la dernière ligne et ça marche
Bstn
est-ce qu'il serait possible de mettre les lignes copiées en couleur afin qu'elles soient identifiables rapidement?
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
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
Bonjour
Avec du jaune
A+
Maurice
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
Bonjour
la touche final
je pense que tu peux Valider
A+
Maurice
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