RESOLU Suprimer des lignes dans plusieurs feuilles en même temps

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous,
Toujours dans mon classeur de suivi de présence, je souhaiterais pouvoir supprimer des lignes dans plusieurs feuilles en même temps.

Voici la macro toute simple que j'ai fait (enfin, heu.... pas moi mais excel)

Sub supprimerligne()
'
' supprimerligne Macro
'

'
Sheets("TicketsRest").Select
ActiveSheet.Unprotect
Sheets("Synthèse").Select
ActiveSheet.Unprotect
Sheets("matrice").Select
ActiveSheet.Unprotect
Sheets(Array("matrice", "Synthèse", "TicketsRest")).Select
Sheets("matrice").Activate
Rows("14:14").Select
Selection.Delete Shift:=xlUp

Sheets("TicketsRest").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Rows("14:14").Select
ActiveSheet.Unprotect
Range("A1:R3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("TicketsRest").Select
ActiveWindow.LargeScroll Down:=0
Sheets("Synthèse").Select
Range("A3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("matrice").Select
Range("A10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Bien évidement, même si dans cette macro, j'ai demandé à supprimer la ligne "14"( voire ligne en rouge), d'autres fois, ce seront des lignes différentes.

C'est pourquoi, je voudrais que la macro que demande quelles lignes je veux supprimer.

Cela est-il possible ?

Pouvez-vous m'aider ?

Avec mes remerciements,
Amicalementn,
Lionel,
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : PRESQUE RESOLU Suprimer des lignes dans plusieurs feuilles en même temps

Bonjour à tous

arthour973

Voici la modification pour gérer le cas Annuler
(PS: Je remets tout le code)
Code:
Sub MainPROC()
Dim lignes As Range
On Error Resume Next
Application.DisplayAlerts = False
Set lignes = Application.InputBox _
            (Prompt:="Sélectionner les lignes à supprimer ", _
            Title:="Suppression de ligne (Selection)", _
            Type:=8)
On Error GoTo 0
If lignes Is Nothing Then
Exit Sub
Else
suplig lignes.Address, "Feuil1", "Feuil2", "Feuil3"
End If
End Sub
Code:
Private Sub suplig(lignes$, ParamArray tf() As Variant)
Dim i As Byte
For i = 0 To UBound(tf)
With Sheets(tf(i))
    .Unprotect
    .Range(lignes).EntireRow.Delete
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Next i
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 220
Messages
2 086 381
Membres
103 199
dernier inscrit
ATS1