XL 2010 VBA - sélection de lignes variable

La Haine · 4 Juin 2018

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 :

VB:

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 · 4 Juin 2018

Bonjour La Haine

Tu peux t'inspirer de ceci

Code:

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

vgendron · 4 Juin 2018

Bonjour
essaie ceci

VB:

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 · 4 Juin 2018

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 · 4 Juin 2018

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 · 4 Juin 2018

Bonjour à tous,

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

VB:

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 · 4 Juin 2018

Merci à tous pour vos réponses !

Lone-wolf à dit:
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 · 4 Juin 2018

Re

Tu peux aussi faire comme ceci

VB:

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

XL 2010 VBA - sélection de lignes variable

La Haine

XLDnaute Nouveau

pierrejean

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

La Haine

XLDnaute Nouveau

Lone-wolf

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

La Haine

XLDnaute Nouveau

Lone-wolf

XLDnaute Barbatruc

Discussions similaires