Remettre le curseur à la cinquième ligne

Le 26/03/2019 à 06:57

Bonjour

Dans mon fichier j'ai 23 feuilles que je commande a partir de la feuille "Index" et toute les feuilles commence à partir de la 5 ème ligne.

J'ai un code pour effacer l'ensemble des données comme ceci:

Sub EffaceTout()
Application.ScreenUpdating = False

   Worksheets("Index").Select: [B5:B1800, J5:J1800].ClearContents: [J5].Select
   Worksheets("path").Select: [B5:B1800].ClearContents: [I5].Select

   Worksheets("lienCantons").Select: [B5:D1800].ClearContents: [I5].Select
   Worksheets("TextCantons").Select: [B5:D1800].ClearContents: [I5].Select
   Worksheets("ListCantons").Select: [B5:D1800].ClearContents: [I5].Select
   Worksheets("ImageCantons").Select: [B5:D1800].ClearContents: [I5].Select

   Worksheets("ListDeroulante").Select: [B5:D1800].ClearContents: [I5].Select

   Worksheets("lienArrond").Select: [B5:D1800,F5:G1800].ClearContents: [I5].Select
   Worksheets("TextArrond").Select: [B5:D1800].ClearContents: [I5].Select
   Worksheets("ListArrond").Select: [B5:D1800].ClearContents: [I5].Select
   Worksheets("imageArrond").Select: [B5:D1800].ClearContents: [I5].Select

   Worksheets("LienCnes").Select: [C5:C1800,F5:G1800 ].ClearContents: [I5].Select
   Worksheets("TextCnes").Select: [C5:C1800].ClearContents: [I5].Select
   Worksheets("ListCnes").Select: [B5:D1800].ClearContents: [I5].Select
   Worksheets("ImageCnes").Select: [B5:D1800].ClearContents: [I5].Select

   Worksheets("LienCir").Select: [B5:B1800, d5:d1800].ClearContents: [B5].Select
   Worksheets("ListCir").Select: [B5:B1800].ClearContents: [B5].Select

Application.EnableEvents = True
Sheets(1).Select
End Sub

Mon problème est que je n'arrive pas à avoir la cinquième ligne en début de mes feuilles je suis toujours ou j'ai laissé ma feuille c'est-à-dire soit à la 320ème ligne ou autre....

Y a t'il un code pour remédier à cela?

Je vous remercie d'avance

Max

Le 26/03/2019 à 07:05

Bonjour,

Pas besoin de sélectionner pour supprimer le contenu des feuilles. Si ce sont toutes les feuilles qui doivent être vidées, une boucle ferait bien l'affaire :

Sub EffaceTout()

    Worksheets("Index").[B5:B1800, J5:J1800].ClearContents
    Worksheets("path").[B5:B1800].ClearContents
    Worksheets("lienCantons").[B5:D1800].ClearContents
    Worksheets("TextCantons").[B5:D1800].ClearContents
    Worksheets("ListCantons").[B5:D1800].ClearContents
    Worksheets("ImageCantons").[B5:D1800].ClearContents
    Worksheets("ListDeroulante").[B5:D1800].ClearContents
    Worksheets("lienArrond").[B5:D1800,F5:G1800].ClearContents
    Worksheets("TextArrond").[B5:D1800].ClearContents
    Worksheets("ListArrond").[B5:D1800].ClearContents
    Worksheets("imageArrond").[B5:D1800].ClearContents
    Worksheets("LienCnes").[C5:C1800,F5:G1800 ].ClearContents
    Worksheets("TextCnes").[C5:C1800].ClearContents
    Worksheets("ListCnes").[B5:D1800].ClearContents
    Worksheets("ImageCnes").[B5:D1800].ClearContents
    Worksheets("LienCir").[B5:B1800, d5:d1800].ClearContents
    Worksheets("ListCir").[B5:B1800].ClearContents

End Sub
Le 26/03/2019 à 07:33

Bonjour Theze

Ton code est plus propre mais sa me solutionne pas mon problème mes feuilles reste toujours a la lignes que j'ai laissé avant d'effacer

ax

Le 26/03/2019 à 08:04

Bonjour,

en essayant comme ça

Sub EffaceTout()
Application.ScreenUpdating = False

   Worksheets("Index").Select: [B5:B1800, J5:J1800].ClearContents
   Application.Goto Range("J5"), True
   Worksheets("path").Select: [B5:B1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("lienCantons").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("TextCantons").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("ListCantons").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("ImageCantons").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True   
   Worksheets("ListDeroulante").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("lienArrond").Select: [B5:D1800,F5:G1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("TextArrond").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("ListArrond").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("imageArrond").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("LienCnes").Select: [C5:C1800,F5:G1800 ].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("TextCnes").Select: [C5:C1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("ListCnes").Select: [B5:D1800].ClearContentst
   Application.Goto Range("I5"), True
   Worksheets("ImageCnes").Select: [B5:D1800].ClearContents
   Application.Goto Range("I5"), True
   Worksheets("LienCir").Select: [B5:B1800, d5:d1800].ClearContents
   Application.Goto Range("B5"), True
   Worksheets("ListCir").Select: [B5:B1800].ClearContents
   Application.Goto Range("B5"), True

Application.EnableEvents = True
Sheets(1).Select
End Sub

Cordialement

Le 26/03/2019 à 08:32

Bjr,

à mon avis il faut activer l'onglet pour ressir la selection.

Le 26/03/2019 à 14:57

Re,

Tu peux le faire à la fin avec une boucle :

Sub EffaceTout()

    Dim I As Integer

    Application.ScreenUpdating = False

    Worksheets("Index").[B5:B1800, J5:J1800].ClearContents
    Worksheets("path").[B5:B1800].ClearContents
    Worksheets("lienCantons").[B5:D1800].ClearContents
    Worksheets("TextCantons").[B5:D1800].ClearContents
    Worksheets("ListCantons").[B5:D1800].ClearContents
    Worksheets("ImageCantons").[B5:D1800].ClearContents
    Worksheets("ListDeroulante").[B5:D1800].ClearContents
    Worksheets("lienArrond").[B5:D1800,F5:G1800].ClearContents
    Worksheets("TextArrond").[B5:D1800].ClearContents
    Worksheets("ListArrond").[B5:D1800].ClearContents
    Worksheets("imageArrond").[B5:D1800].ClearContents
    Worksheets("LienCnes").[C5:C1800,F5:G1800 ].ClearContents
    Worksheets("TextCnes").[C5:C1800].ClearContents
    Worksheets("ListCnes").[B5:D1800].ClearContents
    Worksheets("ImageCnes").[B5:D1800].ClearContents
    Worksheets("LienCir").[B5:B1800, d5:d1800].ClearContents
    Worksheets("ListCir").[B5:B1800].ClearContents

    For I = 1 To Worksheets.Count: Worksheets(I).Activate: Worksheets(I).Cells(5, 9).Select: Next I

    Application.ScreenUpdating = True

End Sub
Rechercher des sujets similaires à "remettre curseur cinquieme ligne"