problème de cellules qui s'effacent lors d'un copier et coller ligne

[micie1509]

Bonjour,

Je veux d'abord vous remercier d'avoir pris le temps de me lire.

J'ai un petit problème, voici: je veux insérer une ligne en dessous de la cellule où mon curseur est situé.
Si je clique en B22 et que j'insère une ligne, il m'insère une ligne en dessous de B22 et ce parfaitement. Par contre la ligne 21 est effacée et toutes mes formules ont disparues. Si j'insère plusieurs lignes, les nouvelles lignes sont parfaites, mais de temps en temps, une ligne de plus est effacée. Je ne comprends pas pourquoi. Qu'est-ce que j'ai fait de travers (ou que je n'ai pas fait et que j'aurais dû faire ) ?

Un gros merci d'avance pour l'aide que vous pourriez m'apporter.

Bonne soirée!

Micie


Sub InsererLigne()
'
' Insérer 1 ligne
'

ActiveSheet.Unprotect

With ActiveCell
Rows(.Row - 1 & ":" & .Row - 1).Insert xlDown
Rows("1").Copy Rows(.Row - 1)
Selection.EntireRow.Hidden = False

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

 

[Victor21]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Bonsoir micie1509

Dans une course, quand le 4° dépasse le 3°, il ne se retrouve pas 2°, mais 3°

Ne serait-ce pas plutôt :

Rows(.Row - 1).Copy Rows("1")

 

[Robert]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Bonsoir micie et bienvenue, bonsoir le forum,

Peut-être comme ça :

Sub InsererLigne()
ActiveSheet.Unprotect
li = ActiveCell.Row + 1
Rows(li).Insert xlShiftDown
Rows(1).Copy Rows(li)
Rows(li).Hidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

[Édition]
Bonsoir Victor on s'est croisé...

 

[job75]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Bonsoir micie1509, Robert,

Avant d'aller dormir :

Sub InsererLigne()
Dim n, L As Range
n = 3 'nombre de lignes à insérer
Set L = ActiveCell.EntireRow
ActiveSheet.Unprotect
L.Resize(n).Insert
Rows(1).Copy L(1 - n).Resize(n)
L(1 - n).Resize(n).Hidden = False
ActiveSheet.Protect
End Sub

Bonne nuit à tous.

 

[Paf]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Bonsoir à tous

une autre proposition:

Sub InsererLigne()
    ActiveSheet.Unprotect

    With ActiveCell
        Rows(.Row).Copy 'copie de la ligne de la cellule active
        Rows(.Row).Insert xlDown 'insertion de la copie en ligne suivante
        Rows(.Row + 1).EntireRow.Hidden = False 'affichage ligne suivante
        Application.CutCopyMode = False 'supprime la marque de sélection
    End With

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Bonne nuit

 

[micie1509]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Wow, merci à tous. Je vais essayer tout ça demain et je vous dirai comment ça fonctionne.

 

[micie1509]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Merci Patrick,

Faut croire que je n'écoute pas assez les Jeux Olympiques

Un gros merci !

 

[job75]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Bonjour le fil, salut Patrick que je n'avais pas vu, salut Paf.

A mon avis c'est bien la ligne 1 qui doit être copiée sur la (les) ligne(s) insérée(s).

Elle est masquée et sert de modèle [Edit] pour les formules et les formats.

Reste à savoir si l'insertion doit se faire au-dessus (comme je le fais) ou au-dessous de la cellule active, mais ça n'a guère d'importance.

Bonne journée.

 

[job75]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Re,

Au lieu de seulement afficher les lignes insérées, il vaut mieux leur donner la hauteur de la cellule active :

Sub InsererLigne()
Dim n, L As Range
n = 3 'nombre de lignes à insérer
Set L = ActiveCell.EntireRow
ActiveSheet.Unprotect
L.Resize(n).Insert
Rows(1).Copy L(1 - n).Resize(n)
L(1 - n).Resize(n).RowHeight = L.RowHeight
ActiveSheet.Protect
End Sub

A+

 

[job75]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Re,

La macro précédente insère au-dessus de la cellule active.

Celle-ci insère au-dessous :

Sub InsererLigne()
Dim n, L As Range
n = 3 'nombre de lignes à insérer
Set L = ActiveCell.EntireRow
ActiveSheet.Unprotect
L(2).Resize(n).Insert
Rows(1).Copy L(2).Resize(n)
L(2).Resize(n).RowHeight = L(n + 2).RowHeight
ActiveSheet.Protect
End Sub

A+

 

[micie1509]

Re : problème de cellules qui s'effacent lors d'un copier et coller ligne

Merci beaucoup, j'aime bien la dernière de job75. Vous êtes géniaux !