dupliquer une ligne dans VBA pour éviter une saisie manuelle

Y compris Power BI, Power Query et toute autre question en lien avec Excel
s
steelband13
Membre habitué
Membre habitué
Messages : 53
Inscrit le : 9 mai 2016
Version d'Excel : excel 2010

Message par steelband13 » 19 janvier 2018, 08:23

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.
Avatar du membre
paritec
Passionné d'Excel
Passionné d'Excel
Messages : 4'294
Appréciations reçues : 500
Inscrit le : 7 juin 2011
Version d'Excel : W10 - 2003 FR - 2010 FR

Message par paritec » 19 janvier 2018, 08:36

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 :)
Des bonnes explications et des petits fichiers représentatifs vont nous aider à vous aider !!!!
s
steelband13
Membre habitué
Membre habitué
Messages : 53
Inscrit le : 9 mai 2016
Version d'Excel : excel 2010

Message par steelband13 » 19 janvier 2018, 08:51

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.
Avatar du membre
paritec
Passionné d'Excel
Passionné d'Excel
Messages : 4'294
Appréciations reçues : 500
Inscrit le : 7 juin 2011
Version d'Excel : W10 - 2003 FR - 2010 FR

Message par paritec » 19 janvier 2018, 09:02

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
Des bonnes explications et des petits fichiers représentatifs vont nous aider à vous aider !!!!
s
steelband13
Membre habitué
Membre habitué
Messages : 53
Inscrit le : 9 mai 2016
Version d'Excel : excel 2010

Message par steelband13 » 19 janvier 2018, 09:32

Désolé Papou,
Je débute et donc, je fais avec mes pauvres moyens et connaissances.
Cordialement,
Avatar du membre
paritec
Passionné d'Excel
Passionné d'Excel
Messages : 4'294
Appréciations reçues : 500
Inscrit le : 7 juin 2011
Version d'Excel : W10 - 2003 FR - 2010 FR

Message par paritec » 19 janvier 2018, 09:52

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 :)
Des bonnes explications et des petits fichiers représentatifs vont nous aider à vous aider !!!!
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message