Dupliquer une ligne dans VBA pour éviter une saisie manuelle
Bonjour,
J'ai enregistré une macro sous excel et je souhaite dupliquer deux lignes.
Je voulais savoir si l'on pouvait faire cela de manière "automatique" pour éviter une saisie manuelle?
Range("A138:A144").Select
Selection.Delete Shift:=xlToLeft
Range("A146:A152").Select
Selection.Delete Shift:=xlToLeft
Range("A154:A160").Select
Selection.Delete Shift:=xlToLeft
Range("A162:A168").Select
Selection.Delete Shift:=xlToLeft
et ainsi de suite jusqu'à la ligne souhaitée.
Merci par avance et bonne journée.
Bonjour Steelband13 le forum
Bonne année 2018
tu nous mets un fichier avec un exemple et les explications dedans et je te fais cela par retour
a+
Papou
Bonjour,
Voici comme apparait la macro que j'ai enregistré.
Sub Macro5()
'
' Macro5 Macro
'
'
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
Cells.Select
Selection.Columns.AutoFit
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Range("A2:A8").Select
Selection.Delete Shift:=xlToLeft
Range("A10:A16").Select
Selection.Delete Shift:=xlToLeft
Range("A18:A24").Select
Selection.Delete Shift:=xlToLeft
Range("A26:A32").Select
Selection.Delete Shift:=xlToLeft
Range("A34:A40").Select
Selection.Delete Shift:=xlToLeft
Range("A42:A48").Select
Selection.Delete Shift:=xlToLeft[/Surligner]
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
TrailingMinusNumbers:=True
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Replace What:=".", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.NumberFormat = "#,##0.00 $"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=R[2]C[-1]"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=R[5]C[-2]"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C46"), Type:=xlFillDefault
Range("C1:C46").Select
ActiveWindow.SmallScroll Down:=-24
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D46"), Type:=xlFillDefault
Range("D1:D46").Select
Range("F23").Select
ActiveWindow.SmallScroll Down:=-27
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "MATRICULE"
Range("C1").Select
ActiveCell.FormulaR1C1 = "MONTANT BRUT"
Range("D1").Select
ActiveCell.FormulaR1C1 = "MONTANT NET"
Range("A1:D47").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.AutoFilter
Selection.Columns.AutoFit
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("F4").Select
End Sub
Elle s'arrête à la ligne 48 mais je souhaiterai par exemple qu'elle aille jusqu'à la ligne 4000.
Merci beaucoup.
Re Bonjour Steelband13 le forum
Il semble que tu ne sais pas lire!!! ( je t'ai demandé un fichier pas la copie de ta macro bidon)
Bref
pour supprimer les cellules comme ta macro de la ligne 2 à la ligne 4000 voilà
a+
Papou
Sub steelband13()
Dim i&
For i = 2 To 4000 Step 8
Range(Cells(i, 1), Cells(i + 6, 1)).Delete shift:=xlToLeft
Next i
End Sub
Désolé Papou,
Je débute et donc, je fais avec mes pauvres moyens et connaissances.
Cordialement,
Re Steelband13 le forum
non pas de soucis pour moi, mais si tu veux des réponses pil poil comme tu le souhaites, le plus simple et de joindre un fichier représentatif de ta demande avec les explications, et ensuite on fait.
Tu sais tout le monde commence par ne pas savoir avant de savoir !!!
a+
Papou