XL 2010 VBA - sélection de lignes variable

[La Haine]

Bonjour à tous,

Débutant sur vba, et après avoir résolu pas mal de problèmes en farfouillant le forum (merci à tous les contributeurs au passage !), me voici bloqué. Je tente de sélectionner les 6 dernières lignes d'un tableau pour les copier / coller valeurs. Je n'arrive qu'à les sélectionner une par une en remontant pour arriver à mes fins, pas les 6 directement. Voici mon code :

Worksheets("exemple").Select
    Range("D1100").Select
    Selection.End(xlUp).Select
    Rows(ActiveCell.Row).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    ActiveCell.Offset(-1, 0).Select
    Rows(ActiveCell.Row).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ActiveCell.Offset(-1, 0).Select
    Rows(ActiveCell.Row).Selec
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ActiveCell.Offset(-1, 0).Select
    Rows(ActiveCell.Row).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ActiveCell.Offset(-1, 0).Select
    Rows(ActiveCell.Row).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ActiveCell.Offset(-1, 0).Select
    Rows(ActiveCell.Row).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Bien entendu, le tableau a systématiquement des lignes qui s'ajoutent, ce ne sont jamais les mêmes lorsque l'on lance le programme.

J'ai cherché un problème similaire sur le forum mais je n'ai pas trouvé, ou pas compris ^^ Si quelqu'un peut me guider ou voir même me donner un lien que je n'ai pas trouvé pouvant m'aider, ce serait sympa !

Merci et bonne journée

 

[pierrejean]

Bonjour La Haine

Tu peux t'inspirer de ceci

Sub test()
lignes = ActiveCell.Row - 1 & ":" & ActiveCell.Row - 6
Rows(lignes).Select
End Sub

 

[vgendron]

Bonjour
essaie ceci

Sub test()
With ActiveSheet
    last = .Range("D" & .Rows.Count).End(xlUp).Row
    .Rows(last - 5).Resize(6).EntireRow.Copy
    .Rows(last - 5).Resize(6).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
  
End With
End Sub

Hello @pierrejean
désolé, raffraichi trop tard :-D

 

[La Haine]

Bonjour Pierrejean,

Ça fonctionne, merci ! J'ai juste enlevé le -1 et en avant Guingamps ! J'ai encore du mal avec ces déclarations, mais du coup tu concatènes puis c'est tout bête.

Merci et bonne journée !

 

[Lone-wolf]

Bonjour La Haine et bienvenue sur XLD

derlig = Cells(Rows.Count, "D").End(3).Row

Cells(derlig, "D").Select
Range(ActiveCell, ActiveCell.Offset(-5, 0)).Select

EDIT: bonjour vgendron, pierrejean

 

[mapomme]

Bonjour à tous,

Un autre essai qui tient compte qu'il peut y avoir moins de 6 lignes.

Sub toto()
Dim derlig As Long, premlig As Long
   With Worksheets("exemple")
      derlig = .Cells(Rows.Count, "d").End(xlUp).Row
      premlig = derlig - 6 + 1
      If premlig < 0 Then premlig = 1
      With .Cells(premlig, "d").Resize(derlig - premlig + 1).EntireRow
         .Value = .Value
      End With
   End With
End Sub

 

[La Haine]

Merci à tous pour vos réponses !

Bonjour La Haine et bienvenue sur XLD

derlig = Cells(Rows.Count, "D").End(3).Row

Cells(derlig, "D").Select
Range(ActiveCell, ActiveCell.Offset(-5, 0)).Select

Ça m'intéresse car c'était là-dessus que j'étais parti au début mais je n'arrivais pas à mettre tout ça dans le bon sens, je vais essayer, merci.

 

[Lone-wolf]

Re

Tu peux aussi faire comme ceci

Sub test()
Dim x&
  x = Range("d" & Rows.Count).End(3).Row
  Application.ScreenUpdating = False

  Application.Goto Range("d" & x)
  Range(ActiveCell, ActiveCell.Offset(-5, 0)).Copy
  'À modifier
  Range("f2").PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.Goto Range("d2")
End Sub