XL 2013 Ajouter autant de lignes que supprimées

[Neofalken]

Bonjour à tous,

Voilà mon soucis :
Pour un fichier de devis (protégé) j'ai une feuille récapitulative qui récupère la sélection d'une autre feuille.
Il peut arriver que le commercial se rende compte qu'il a saisi un ou plusieurs mauvais articles.
J'ai donc fait une petite macro qui permet de mettre une croix en bout de ligne qui supprime les mauvais articles (en déprotégeant reprotégeant la feuille) :
Sub SupLigneX()
With ThisWorkbook.ActiveSheet
.Unprotect "xxxxxx"
Application.ScreenUpdating = False
For i = [A65000].End(xlUp).Row To 1 Step -1
If Left(Cells(i, 19), 4) = "x" Then Rows(i).Delete
Next i
.Protect Password:="xxxxxx", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFiltering:=True
Application.Calculate
ActiveWindow.SmallScroll Up:=8500 'Affichage du haut de page
End With
End Sub

ça fonctionne )

Puis l'opérateur appuies sur un bouton pour afficher la preview de l'offre avant impression en pdf, c'est à dire que cela va masquer toutes les lignes vides (à la base il y a 12 pages vides potentientiellement remplissables par la sélection initiale)

Private Sub Preview_Offre()
With ThisWorkbook.ActiveSheet
.Unprotect "xxxxxx"
NbArt = Range("A" & Rows.Count).End(xlUp).Row + 1 'compte le nombre de lignes àrécupérer
j = 18 'définit la 1è ligne à récupérer
If Range("A" & 18) = "***" Then j = j + 1
For i = j To NbArt
If Len(Range("B" & i)) > 80 Then 'gère la hauteur des lignes à afficher
Rows(i).RowHeight = 42
ElseIf Len(Range("B" & i)) > 40 Then Rows(i).RowHeight = 28
Else: Rows(i).RowHeight = 18
End If
Next i
Range("A" & NbArt & ":A" & 749).EntireRow.Hidden = True 'masque les lignes superflues
.Protect "xxxxxx"
End With
Call AffichageTotal_YN
End Sub

Dans le principe cela fonctionne aussi, mais le problème c'est que j'ai une base non modifiable avant et après les lignes remplissables (entre ligne 1 et 17 et après ligne 749) et avec ce système je fige la ligne 749 comme limite et donc quand je supprime une ou des lignes la base non modifiable remonte logiquement et se retrouve tout ou partie avant la ligne 749. et est donc masquée avec Private Sub Preview_Offre()
Il faudrait que je puisse copier/insérer-coller (j'ai des formules dans les lignes remplissables) autant de lignes que l'opérateur en supprime avec Sub SupLigneX()
afin que ma base soit positionnée toujours aux même lignes (à partir de la ligne 750)

et là je coince...

Je sais que vous préférez toujours avoir un fichier joint...mais là le fichier est bcp trop lourd...désolé mais j'espère avoir été assez clair...

Merci d'avance

 

[Staple1600]

Bonsoir le fil

Neofalken
Petit conseil du soir (en passant)
L'usage est de joindre un fichier exemple créé spécifiquement pour illustrer la question
(fichier allégé avec des données fictives et anonymes)

Sinon, (ça peut toujours servir), une autre façon de faire pour supprimer les lignes avec X
(sans devoir passer par une boucle)

Sub SuppLigX_bis()
Dim Lig&, plg As Range
Application.ScreenUpdating = False
Lig = Cells(Rows.Count, 1).End(3).Row
Set plg = Range(Cells(1, Columns.Count), Cells(Lig, Columns.Count))
plg.Formula = "=IF(S1=""x"",1,""$"")"
plg.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
plg.Clear
End Sub

On ne joint jamais de fichier "original" tout juste sorti de sons jus (depuis l'ordi du boulot)