Revenir à la cellule de départ

tactic6

tactic6

XLDnaute Impliqué
Bonjour le forum
dans mon appli j'ai crée une macro qui me permet d'insérer une ligne
voici son code
Code: 
Sub nouvelleligne1()
    Dim iR&, i&, k&, Ak&
  Application.ScreenUpdating = False
  Worksheets("SAISIE").Unprotect
    iR = ActiveCell.Row
    Rows(iR).Insert
    For a = 15 To 42
        If IsEmpty(Cells(a, 3)) Then
        Cells(a, 3).FormulaLocal = "=SI(NON(ESTVIDE(B" & a & "));RECHERCHEV(B" & a & ";'liste des articles'!$A$2:$D$10000;2;FAUX);"""")"
        End If
Next
      For Z = 15 To 42
        If IsEmpty(Cells(Z, 9)) Then
        Cells(Z, 9).FormulaLocal = "=SI(NON(ESTVIDE(B" & Z & "));RECHERCHEV(B" & Z & ";'liste des articles'!$A$1:$D$10000;4;FAUX);"""")"
        End If
Next
      For j = 15 To 42
        If IsEmpty(Cells(j, 11)) Then
        Cells(j, 11).FormulaLocal = "=SI(NON(ESTVIDE(B" & j & "));RECHERCHEV(B" & j & ";'liste des articles'!$A$1:$D$10000;3;FAUX);"""")"
        End If
Next
    Range("B51:K51").Select
    Selection.Delete Shift:=xlUp
    Worksheets("SAISIE").Protect
    Application.ScreenUpdating = True

    End Sub
Cette macro me rajoute une ligne sur la cellule qui est sélectionnée et ensuite réécrit les formules et pour finir pour que mon tableau reste à la même taille me supprime une ligne en fin de tableau

Mes requêtes sont les suivantes :
-Comment faire pour que je revienne directement sur la cellule sélectionnée avant insertion de ligne
-Comment limiter l'insertion de ligne uniquement si la cellule sélectionnée est comprise entre B15 et B50
-Comment limiter l'insertion aux colonnes B à K ceci parce que j'ai des boutons de commande à droite de mon tableau et qu'actuellement à chaque insertion de ligne mes boutons descendent aussi

Merci et bonne journée
 
Trier par date Trier par votes
B

Banzai64

XLDnaute Accro
Re : Revenir à la cellule de départ

Bonjour

sans test essayes ce code

Code: 
Sub nouvelleligne1()
  Dim iR&, i&, k&, Ak&
  If ActiveCell.Row < 15 Or ActiveCell.Row > 50 And ActiveCell.Column <> 2 Then Exit Sub
  Application.ScreenUpdating = False
  Worksheets("SAISIE").Unprotect
    iR = ActiveCell.Row
    Range("B" & iR & ":K" & iR).Insert Shift:=xlDown
    'Rows(iR).Insert
    For a = 15 To 42
        If IsEmpty(Cells(a, 3)) Then
        Cells(a, 3).FormulaLocal = "=SI(NON(ESTVIDE(B" & a & "));RECHERCHEV(B" & a & ";'liste des articles'!$A$2:$D$10000;2;FAUX);"""")"
        End If
    Next
    For Z = 15 To 42
      If IsEmpty(Cells(Z, 9)) Then
      Cells(Z, 9).FormulaLocal = "=SI(NON(ESTVIDE(B" & Z & "));RECHERCHEV(B" & Z & ";'liste des articles'!$A$1:$D$10000;4;FAUX);"""")"
      End If
    Next
    For j = 15 To 42
      If IsEmpty(Cells(j, 11)) Then
      Cells(j, 11).FormulaLocal = "=SI(NON(ESTVIDE(B" & j & "));RECHERCHEV(B" & j & ";'liste des articles'!$A$1:$D$10000;3;FAUX);"""")"
      End If
    Next
    Range("B51:K51").Delete Shift:=xlUp
    Worksheets("SAISIE").Protect
    Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Revenir à la cellule de départ

Bonjour tactic et Banzai,

Puisque j'ai testé, je propose :
Code: 
Sub nouvelleligne1()
    Dim iR, i&, k&, Ak&, a, j, Z, CDep
    Application.ScreenUpdating = False
    Worksheets("SAISIE").Unprotect
    CDep = ActiveCell.Address
    iR = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 11)).Address
    If ActiveCell.Row >= 15 And activecelle.Row <= 50 Then
        Range(iR).Insert Shift:=xlDown
        Range("B51:K51").Delete Shift:=xlUp
        Range(CDep).Select
    End If
    For a = 15 To 42
        If IsEmpty(Cells(a, 3)) Then
            Cells(a, 3).FormulaLocal = "=SI(NON(ESTVIDE(B" & a & "));RECHERCHEV(B" & a & ";'liste des articles'!$A$2:$D$10000;2;FAUX);"""")"
        End If
    Next
      For Z = 15 To 42
        If IsEmpty(Cells(Z, 9)) Then
            Cells(Z, 9).FormulaLocal = "=SI(NON(ESTVIDE(B" & Z & "));RECHERCHEV(B" & Z & ";'liste des articles'!$A$1:$D$10000;4;FAUX);"""")"
        End If
    Next
      For j = 15 To 42
        If IsEmpty(Cells(j, 11)) Then
            Cells(j, 11).FormulaLocal = "=SI(NON(ESTVIDE(B" & j & "));RECHERCHEV(B" & j & ";'liste des articles'!$A$1:$D$10000;3;FAUX);"""")"
        End If
    Next
    Worksheets("SAISIE").Protect
    Application.ScreenUpdating = True

End Sub

A+
 
Dernière édition:
Vote positif 0 Vote négatif
tactic6

tactic6

XLDnaute Impliqué
Re : Revenir à la cellule de départ

Banzai une fois encore ton code me convient parfaitement
j'ai l'impression que tu arrives à lire dans mon esprit
@Fred0o
Merci infiniment pour ton aide
ton code est intéressant je vais tacher de m'instruire avec
 
Vote positif 0 Vote négatif
tactic6

tactic6

XLDnaute Impliqué
Re : Revenir à la cellule de départ

Bonsoir le forum
Je fais remonter le fil car j'ai un petit probleme
Il se trouve que dans la colonne J j'ai une formule
Code: 
=SI(Iu<>"";Hu*Iu;"")
u étant le numéro de la ligne selectionnée
Exemple: pour la ligne 18 on aurait
Code: 
=SI(I18<>"";H18*I18;"")

j'ai voulu modifier le code de Banzai ci dessus pour en tenir compte
j'y ai donc ajouté ce bout de code
Code: 
For u = 15 To 42
      If IsEmpty(Cells(u, 10)) Then
      [COLOR="red"]Cells(u, 10).FormulaLocal = "=SI(I" & u & "<>"";H" & u & "*I" & u & ")"[/COLOR]
      End If
 Next
mais j'ai une erreur 1004 à la ligne en rouge

pourriez vous m'aiguiller svp

Merci
Bonne soirée
 
Vote positif 0 Vote négatif
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Revenir à la cellule de départ

Bonjour Tactic,

Essaie en remplaçant le SI par IF, comme ceci :
Code: 
[COLOR=red][COLOR=blue]Cells(u, 10).FormulaLocal = "=[/COLOR]IF[COLOR=blue](I" & u & "<>"";H" & u & "*I" & u & ")"[/COLOR][/COLOR]

A+
 
Vote positif 0 Vote négatif
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Revenir à la cellule de départ

Re-Bonsoir,

Je viens de tester et en effet cela ne fonctionnait pas. Voici la modification qui fonctionne chez moi (Là, j'ai testé !)

Code: 
Range("J" & u).FormulaLocal = "=SI(I" & u & "<>"""";H" & u & "*I" & u & ";"""")"

A+
 
Vote positif 0 Vote négatif
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Revenir à la cellule de départ

Re-bonsoir,

Là, c'est difficile de te répondre avec juste une instruction de la macro.

Postes-nous la macro complète et on pourra voir pourquoi tu ne reviens pas à la cellule de départ. Les instructions que je t'ai données ne modifient pas la position actuelle du pointeur.

A+
 
Vote positif 0 Vote négatif
tactic6

tactic6

XLDnaute Impliqué
Re : Revenir à la cellule de départ

Re
Voici donc le code complet
Code: 
Sub nouvelleligne1()
    Dim iR&, i&, k&, Ak&
  Application.ScreenUpdating = False
  If ActiveCell.Row < 15 Or ActiveCell.Row > 50 And ActiveCell.Column <> 2 Then Exit Sub
  Application.ScreenUpdating = False
  Worksheets("SAISIE").Unprotect
    iR = ActiveCell.Row
    Range("B" & iR & ":K" & iR).Insert Shift:=xlDown
      For a = 15 To 50
        If IsEmpty(Cells(a, 3)) Then
        Cells(a, 3).FormulaLocal = "=SI(NON(ESTVIDE(B" & a & "));RECHERCHEV(B" & a & ";'liste des articles'!$A$2:$D$10000;2;FAUX);"""")"
        End If
    Next
    For Z = 15 To 50
      If IsEmpty(Cells(Z, 9)) Then
      Cells(Z, 9).FormulaLocal = "=SI(NON(ESTVIDE(B" & Z & "));RECHERCHEV(B" & Z & ";'liste des articles'!$A$1:$D$10000;4;FAUX);"""")"
      
      
      End If
    Next
    For j = 15 To 50
      If IsEmpty(Cells(j, 11)) Then
      Cells(j, 11).FormulaLocal = "=SI(NON(ESTVIDE(B" & j & "));RECHERCHEV(B" & j & ";'liste des articles'!$A$1:$D$10000;3;FAUX);"""")"
      End If
    Next
    [COLOR="sienna"]For u = 15 To 50
      If IsEmpty(Cells(u, 10)) Then
      Cells(u, 10).FormulaLocal = "=SI(I" & u & "<>"""";H" & u & "*I" & u & ";"""")"
      End If
    Next[/COLOR]
    Range("B51:K51").Delete Shift:=xlUp
    Range("B15").Select
    Worksheets("SAISIE").Protect
    Application.ScreenUpdating = True

End Sub

Bien sur c'est pareil avec
Code: 
Sub nouvelleligne1()
    Dim iR&, i&, k&, Ak&
  Application.ScreenUpdating = False
  If ActiveCell.Row < 15 Or ActiveCell.Row > 50 And ActiveCell.Column <> 2 Then Exit Sub
  Application.ScreenUpdating = False
  Worksheets("SAISIE").Unprotect
    iR = ActiveCell.Row
    Range("B" & iR & ":K" & iR).Insert Shift:=xlDown
     For a = 15 To 50
        If IsEmpty(Cells(a, 3)) Then
        Cells(a, 3).FormulaLocal = "=SI(NON(ESTVIDE(B" & a & "));RECHERCHEV(B" & a & ";'liste des articles'!$A$2:$D$10000;2;FAUX);"""")"
        End If
    Next
    For Z = 15 To 50
      If IsEmpty(Cells(Z, 9)) Then
      Cells(Z, 9).FormulaLocal = "=SI(NON(ESTVIDE(B" & Z & "));RECHERCHEV(B" & Z & ";'liste des articles'!$A$1:$D$10000;4;FAUX);"""")"
      
      
      End If
    Next
    For j = 15 To 50
      If IsEmpty(Cells(j, 11)) Then
      Cells(j, 11).FormulaLocal = "=SI(NON(ESTVIDE(B" & j & "));RECHERCHEV(B" & j & ";'liste des articles'!$A$1:$D$10000;3;FAUX);"""")"
      End If
    Next
   [COLOR="sienna"] For u = 15 To 50
      Range("J" & u).FormulaLocal = "=SI(I" & u & "<>"""";H" & u & "*I" & u & ";"""")"
    Next[/COLOR]
    Range("B51:K51").Delete Shift:=xlUp
    Range("B15").Select
    Worksheets("SAISIE").Protect
    Application.ScreenUpdating = True

End Sub

Merci
 
Vote positif 0 Vote négatif

Discussions similaires

piga25
  • Résolu(e)
XL 2016 Mettre la même couleur de la dernière cellule colorée
Réponses
5
Affichages
150
TooFatBoy
TooFatBoy
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
321
fanch55
fanch55
S
  • Résolu(e)
XL 2019 Problème de remplissage cellule en vba
Réponses
5
Affichages
167
snoopy07
S
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
515
Nicolas JACQUIN
Nicolas JACQUIN
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
238
GClaire
G
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
303
florian50470
F
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
244
Le Rouky
L
Nicolas JACQUIN
  • Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
405
TooFatBoy
TooFatBoy
S
  • Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
3
Affichages
353
salma_hayek
S
Sergent_Lipton
  • Résolu(e)
Microsoft 365 [VBA] Barre de recherche dynamique - objectif : cacher les lignes hors résultat
Réponses
3
Affichages
250
Sergent_Lipton
Sergent_Lipton

Membres actuellement en ligne

29 membres et 286 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 938
Messages
2 093 784
Membres
105 825
dernier inscrit
Bestio Flavio