(bernard?)supprimer ligne sur plusieurs feuille

  • Initiateur de la discussion Alex
  • Date de début
A

Alex

Guest
Bonjour

J'ai un petit programme qui me permet de supprimer une ligne suivant une catégorie choisie
Je voudrais a partir de cela faire pour que la ligne que je supprime soit supprimé sur toutes les feuilles
Le fichier joint présente la situation et dans le code sont présent mes tentatives
Merci d'avance

ps: pour lajoutj'aimerais faire la meme chose
 

Pièces jointes

  • ajoutsupp.zip
    14.8 KB · Affichages: 14
  • ajoutsupp.zip
    14.8 KB · Affichages: 18
  • ajoutsupp.zip
    14.8 KB · Affichages: 15
J

Jon

Guest
bonjour



tu trouveras ci-dessous deux macros.
une d'elle crée des plages nommées cat1, cat2, cati en bouclant sur les valeurs de la première colonne de la feuille Base.

l'autre est un exemple d'ajout.
j'avais des problèmes lors de l'insertion de la ligne avec l'adresse de la plage nommée, alors je redéfinis la plage nommée à chaque ajout.

je n'ai pas travaillé sur la suppression
mais cela devrait ressembler à ça :

myCat="cat1"
zename="toto"
for each sh in worksheets
if sh.name<>"Base" then
set xx=sh.range([cat1].address(0,0)).find(what:=zeName)
if not xx is nothing then xx.entirerow.delete
end if
next sh

Sub CreationNoms()
Dim i As Integer, j As Integer, rg2build As Range, indexCategorie

For i = 2 To [A65536].End(xlUp).Row

If Feuil1.Range("a" & i).Interior.ColorIndex = 48 Then

j = i
Set rg2build = Cells(i, 1)

Do
j = j + 1
If Cells(j, 1).Interior.ColorIndex = 48 Then Exit Do
Set rg2build = Union(rg2build, Cells(j, 1))
Loop

i = j - 1

End If
If Not rg2build Is Nothing Then
indexCategorie = indexCategorie + 1
ActiveWorkbook.Names.Add "Cat" & indexCategorie, RefersTo:="=" & rg2build.Address()
End If
Set rg2build = Nothing
Next i

End Sub



Sub MonAjoutdePersonne()
CreationNoms
Dim i As Byte
Application.ScreenUpdating = False
' Affiche le message de la catégorie
myCat = InputBox("Veuillez entrer le N° de la catégorie !", "CATEGORIE")
MyName = InputBox("Veuillez entrer le nom à rajouter !", "AJOUTER")

Set xx = Range(myCat)
If Not xx Is Nothing Then
xx.Select
xx.Item(xx.Cells.Count + 1).EntireRow.Insert shift:=xlShiftDown
'Range(MyCat).Item(Range(MyCat).Rows.Count).Value = MyName
xx.Item(xx.Cells.Count + 1).Value = MyName

ActiveWorkbook.Names.Add "Cat" & myCat, RefersTo:="=" & xx.Resize(xx.Cells.Count + 1).Address
End If

[A1].Select
Application.ScreenUpdating = True
End Sub



bye bye
HTH
 

Discussions similaires

Réponses
6
Affichages
173

Statistiques des forums

Discussions
312 518
Messages
2 089 249
Membres
104 079
dernier inscrit
RodLemar