Microsoft 365 Changer code pour sélectionner 3lignes avec un pas de 1

[laplayast]

Bonjour,
je souhaite modifier le code dessous: pour sélectionner 3 lignes avec un intervalle de 1 toutes les 3 lignes; jusqu’à la ligne 2011. (3 lignes sélectionnées, 1 ligne non sélectionnée, 3 lignes sélectionnées, 1 ligne non sélectionnée, ainsi de suite jusqu'à la ligne 2011.
Besoin de la communauté.
Merci.


Sub Macro1()

Dim i As Integer
Dim istart, imax As Integer
Dim istep As Integer
Dim r1, tout As Range

Set tout = Nothing
i = 0
istart = 11
imax = 2011
istep = 4

Application.ScreenUpdating = False

For i = istart To imax Step istep
Set r1 = Range(i & ":" & i)
If tout Is Nothing Then
Set tout = r1
Else
Set tout = Union(tout, r1)
End If
Next

tout.Select

Application.ScreenUpdating = True
' option
'Range("a" & i - istep).Activate

End Sub

 

[mapomme]

Bonsoir @laplayast ,

Votre demande n'est pas très claire selon moi .

nota : la méthode utilisant Union(...) est naturelle mais présente l'inconvénient de la lenteur quand le nombre de lignes à traiter augmente et devient grand. Union(...) est une instruction lente.

Essayez ce code :

Sub Macro1()
Const deb = 11, fin = 2011, pas = 4
Dim m As Long, xrg As Range

   Set xrg = Cells(deb, "i").Resize(pas - 1)    ' on initialise xrg avec le premier 'paquet'
   For m = deb + pas To fin Step pas            ' pour chaque ligne m début des paquets suivants
      Set xrg = Union(xrg, Cells(m, "i").Resize(pas - 1))   'on ajoute à xrg le paquet suivant
   Next m
   Set xrg = Intersect(xrg, Rows(deb & ":" & fin))    'on limite xrg entre la ligne deb et la ligne fin
   xrg.Select     'on sélectionne xrg
End Sub

 

[laplayast]

Bonjour mapomme,

Le code est fonctionnel c'est un bon point. Je souhaite qu'il sélectionne les colonnes de la A à la AM; comme dans le fichier joint(cellules bleues, trame). En l'état la macro1 n'est efficace que sur la colonne i . Possible d'améliorer le code pour sélectionner les bonnes cellules.
Merci encore.

 

[mapomme]

Bonjour @laplayast ,

Essayez avec ce code :

Sub Macro1()
Const deb = 11, fin = 2011, pas = 4
Dim m As Long, xrg As Range, nbrCol As Long

   nbrCol = Range("am1").Column
   Set xrg = Cells(deb, "a").Resize(pas - 1, nbrCol)   ' on initialise xrg avec le premier 'paquet'
   For m = deb + pas To fin Step pas            ' pour chaque ligne m début des paquets suivants
      Set xrg = Union(xrg, Cells(m, "a").Resize(pas - 1, nbrCol))  'on ajoute à xrg le paquet suivant
   Next m
   Set xrg = Intersect(xrg, Rows(deb & ":" & fin))    'on limite xrg entre la ligne deb et la ligne fin
   xrg.Select     'on sélectionne xrg
End Sub

 

[laplayast]

Bonjour mapomme,
Tout nickel, merci de l'aide.
Cdlt