Macro ajout ligne et

[biablo]

Bonjour,

Je n'ai pas trouver mon bonheur sur le site donc je poste.

J'ai un classeur excel portégé qui est utilisé par des personne n'ayant pas le code de déprotection.

Cette execl est de base composé que d'une ligne à remplir.

Mon souci et que ces personnes l'utilisant doivent pouvoir ajouter des lignes ou les supprimer. j'ai creer une macro qui deverrouille la fiche, qui permet l'insertion ou la suppression de la ligne et qui reprotege la fiche avec MDP.

J'ai un souci à l'exécution: la ligne ajoutée ou supprimée se fait en ligne12 (ce qui apres plusieurs ajout décale les cellule rempli en dessous et je ne parle pas de la suppression).

Je connais l'erreur (c'est moi qui lui dit de d'agir sur la ligne 12 dans les macro) mais je n'arrive pas à trouver la solution

Quelqu'un peut-il m'aider??

voici le Code:

Sub
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False, Password:="qualité"

Sheets("ARI").Select
Rows("12:12").Select
Selection.Insert Shift:=xlDown
Range("A11:S11").Select
Selection.AutoFill Destination:=Range("A11:S12"), Type:=xlFillDefault
Range("A11:S12").Select
Sheets("Suivi").Select
Rows("12:12").Select
Selection.Insert Shift:=xlDown
Range("A11:H11").Select
Selection.AutoFill Destination:=Range("A11:H12"), Type:=xlFillDefault
Range("A11:H12").Select
Sheets("ARI").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="qualité"
Range("A12").Select
End sub

J'ai essayer un boucle while avec compteur mais le probleme repose sur la ligne en rouge. je n'arrive pas à l'incrémenter

Autre piste utiliser une ligne fusionnée nommé ("vide") et faire exécuter la macro juste au dessus mais la aussi mes connaissances sont trop limitées....

(détails de la boucle While :

Dim nom1 As String
Dim counter As Integer

counter = 11
nom1 = Worksheets("ARI").Range("A" & counter).Value

While nom1 <> ""

counter = counter + 1
nom1 = Worksheets("ARI").Range("A" & counter).Value
Wend

)

Meric d'avance....

 

[mutzik]

Re : Macro ajout ligne et

bonjour Biablo, le forum

ton fichier avec des données non confidentielles nous serait d'une plus grande utilité ...

 

[kjin]

Re : Macro ajout ligne et

Bojour,
Pas sûr d'avoir tout compris

Autre piste utiliser une ligne fusionnée nommé ("vide") et faire exécuter la macro juste au dessus mais la aussi mes connaissances sont trop limitées....

Cette solution peut fonctionner, mais inutile de fusionner une ligne, il suffit de nommer la cellule A12 "Cible" par exemple et ensuite

Range("Cible").EntireRow.Insert

A+
kjin

 

[biablo]

Macro ajout ligne

Voici le fichier. Désolé si j'ai du mal à me faire comprendre mais ce n'est pas une chose simple à expliquer.

Il faut que la ligne à ajouter soit ajout au dessus de la ligne rouge et que les conditions des cellules soit les même que celle juste au dessus. De meme pour la suppression, la ligne au dessus de la ligne rouge doit se supprimé.


Cette action doit se repercuter aussi dans le second onglet.


Merci

tous les MDP sont " qualité"

 

[kjin]

Re : Macro ajout ligne et

Re,
Pas très bien compris à quoi sert la variable nom1
Tu pourrais supprimer toutes les lignes et ajouter les formules en VBA, donc pour l'instant je vérifie juste que la ligne 11 n'est pas la dernière ligne pour ne pas la supprimer (et du coup conserver les formules)

Public Derlign As Integer
Sub add()
Dim Derlign As Integer
Derlign = Range("J10").End(xlDown).Row + 1
ActiveSheet.Unprotect Password:="qualité"
Application.ScreenUpdating = False
With Sheets("ARI")
    .Unprotect Password:="qualité"
    .Range("A" & Derlign).EntireRow.Insert
    .Range("A" & Derlign - 1 & ":S" & Derlign - 1).AutoFill Destination:=.Range("A" & Derlign - 1 & ":S" & Derlign), Type:=xlFillDefault
    .Protect Password:="qualité"
End With
With Sheets("Suivi")
    .Unprotect Password:="qualité"
    .Range("F" & Derlign).EntireRow.Insert
    .Range("A" & Derlign - 1 & ":H" & Derlign - 1).AutoFill Destination:=.Range("A" & Derlign - 1 & ":H" & Derlign), Type:=xlFillDefault
    .Protect Password:="qualité"
End With
Application.ScreenUpdating = True
End Sub
Sub delete()
Derlign = Range("J10").End(xlDown).Row
If Derlign <> 11 Then
Application.ScreenUpdating = False
Sheets("ARI").Unprotect Password:="qualité"
Sheets("Suivi").Unprotect Password:="qualité"
Sheets("ARI").Rows(Derlign).delete
Sheets("Suivi").Rows(Derlign).delete
Sheets("ARI").Protect Password:="qualité"
Sheets("Suivi").Protect Password:="qualité"
Application.ScreenUpdating = True
End If
End Sub

A+
kjin

 

[biablo]

Re : Macro ajout ligne et

Merci Kjin cela marche parfaitement!!!!


Pour l'histoire, ce fichier permet de conduire une analyses de risque AMDEC pour l'industrie pharma. L'utilisation de cette feuille ne peut se faire que sous certaines conditions (validation de la fiche excel et modification impossible par les utilisateurs de la forme et des calcul de la fiche). Ce ne serait que moi, je ne verrouillerais rien car les données ne sont pas critiques

Merci beaucoup