Insertion ligne avec copie certaines cellules ligne précédente

**John Parker** · 22/08/2013, 09h52

Bonjour,

Ayant encore et toujours du mal avec VBA je me tourne une nouvelle fois vers ce cher forum qui m'est toujours venu en aide

J'ai créé un bouton qui m'insère une nouvelle ligne tout en copiant la ligne précédente. Mon problème est que je n'ai pas besoin de toute la ligne mais seulement de la cellule de la première colonne de cette ligne et de la 8ème.

L'intérêt est de gérer un planning en ajoutant des lignes qui conservent les formules de la ligne précédente mais ces formules se trouvent uniquement en colonne A et H. Je n'ai donc pas besoin de ce qui se trouve entre et après.
Je vous met le code que j'ai fait pour le moment.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
Sub InsererLigneSem1()
Dim L As Long
 
 
        L = ActiveCell.Row
 
            With Sheets("Semaine 1")
                .Rows(L - 1).Copy
                .Rows(L).Insert Shift:=xlDown       'Insertion
                .Rows(L).EntireRow.Hidden = False  'Rendre visible la ligne insérée
            End With
 
 
    Application.CutCopyMode = False
End Sub

Merci d'avance pour votre aide

**casefayere** · 22/08/2013, 10h39

Bonjour,
essayes comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub InsererLigneSem1()
Dim L As Long, Dc As Integer
L = ActiveCell.Row
With Sheets("Semaine 1")
  Dc = Cells(L, .Columns.Count).End(xlToLeft).Column
  .Rows(L - 1).Copy
  .Rows(L).Insert Shift:=xlDown    'Insertion
  .Range("B" & L, "G" & L).ClearContents: .Range(.Cells(L, 9), .Cells(L, Dc)).ClearContents
End With
Application.CutCopyMode = False
End Sub

**John Parker** · 22/08/2013, 11h06

Merci pour ta réponse. Malheureusement, ce code ne réponds pas à mes besoins.
Je te met un exemple du fichier.
Tu remarqueras que la ligne 5 qui sert de référence pour la copie de la première journée est masquée. En dessous de chaque ligne contenant la date de la journée de la semaine il y a une ligne masquée qui sert de référence pour la copie de formule.

Si ce que je te dis n'est pas clair n'hésite pas à me demander

**casefayere** · 22/08/2013, 11h29

Essayes comme ça, sans garantie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub InsererLigneSem1()
 
Dim L As Long, Dc As Integer
L = ActiveCell.Row
 
With ActiveSheet
  Dc = Cells(L, .Columns.Count).End(xlToLeft).Column
  .Rows(L - 1).Copy
  .Rows(L).Insert Shift:=xlDown    'Insertion
  .Rows(L).EntireRow.Hidden = False  'Rendre visible la ligne insérée
  .Range("B" & L, "G" & L).ClearContents
End With
Application.CutCopyMode = False
End Sub

**John Parker** · 23/08/2013, 09h56

Bonjour,
Je reviens vers vous pour une question.
Le code fonctionne bien mais il est un peu lent à s'exécuter ce qui n'est pas très pratique pour l'utilisateur. Je pense que l'étape consistant à effacer les cellules comprises entre les colonnes B et G ralentit l'exécution de la macro.
Est il possible de copier uniquement la cellule de la colonne A et H de la ligne précédente?

Merci d'avance

**casefayere** · 23/08/2013, 10h29

Bonjour,

Le code fonctionne bien mais il est un peu lent à s'exécuter ce qui n'est pas très pratique pour l'utilisateur. Je pense que l'étape consistant à effacer les cellules comprises entre les colonnes B et G ralentit l'exécution de la macro.

Je ne vois pas pourquoi

Est il possible de copier uniquement la cellule de la colonne A et H de la ligne précédente?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub InsererLigneSem1()
 
Dim L As Long, Dc As Integer
L = ActiveCell.Row
 
With ActiveSheet
  .Rows(L).Insert Shift:=xlDown
  .Range("A" & L) = .Range("A" & L - 1)
  .Range("H" & L) = .Range("H" & L - 1)
End With
Application.CutCopyMode = False
End Sub

**John Parker** · 23/08/2013, 11h04

C'est exactement ce que je voulais!

Par contre quand j'ai déjà plusieurs lignes de rentrer et que je souhaite en insérer des nouvelles il y a une petite lenteur avant l'insertion (calcul du processeur). Je ne sais pas si c'est normal?

**casefayere** · 23/08/2013, 11h12

Si tu mets un point d'arrêt dans ton code, juste après l'insertion, quel temps jusqu'au point d'arrêt ?

**John Parker** · 23/08/2013, 11h23

J'ai inséré un point d'arrêt juste après le EndWith. Environ 3secondes avant l'exécution

**casefayere** · 23/08/2013, 11h29

Fais ce que je t'ai dit, insères le juste après l'insertion, sur la ligne 8 (.Range("A" & L) = .Range("A" & L - 1)), c'est là où je voudrais savoir

**John Parker** · 23/08/2013, 11h37

Je te le confirme, environ 3 secondes.

**casefayere** · 23/08/2013, 11h40

Essayes comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub InsererLigneSem1()
 
Dim L As Long, Dc As Integer
Application.ScreenUpdating = False
L = ActiveCell.Row
 
With ActiveSheet
  .Rows(L).Insert Shift:=xlDown
  .Range("A" & L) = .Range("A" & L - 1)
  .Range("H" & L) = .Range("H" & L - 1)
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

**John Parker** · 23/08/2013, 11h53

Toujours 3 secondes même un peu plus

**casefayere** · 23/08/2013, 11h59

Ah ! zut,

Essayes comme ça (sans conviction) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub InsererLigneSem1()
Application.ScreenUpdating = False
Dim L As Long, Dc As Integer
L = ActiveCell.Row
With ActiveSheet
  .Rows(L).Insert Shift:=xlDown
  .Rows(L).EntireRow.Hidden = False
  Application.Calculation = xlCalculationManual
  .Range("A" & L) = .Range("A" & L - 1).Formula
  .Range("H" & L) = .Range("H" & L - 1).Formula
End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

**John Parker** · 23/08/2013, 14h04

Toujours le même problème. Ca fonctionne bien quand il n'y a pas de lignes d'insérer mais dès qu'il y en a plusieurs ça lag...

**casefayere** · 23/08/2013, 14h11

Donc je n'ai pas de solution immédiate, je verrai, dès que je pourrai, si on peut faire autrement

**John Parker** · 23/08/2013, 14h19

Pas de soucis je te remercie

J'ai juste une autre question, j'ai conservé ce code ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub InsererLigneSem1()
 
Dim L As Long, Dc As Integer
L = ActiveCell.Row
 
With ActiveSheet
  .Rows(L).Insert Shift:=xlDown
  .Range("A" & L) = .Range("A" & L - 1)
  .Range("H" & L) = .Range("H" & L - 1)
  .Range("I" & L) = .Range("I" & L - 1)
End With
Application.CutCopyMode = False
 
End Sub

et je voulais savoir s'il était possible de conserver la mise en forme pour les lignes uniquement (qui sont en pointillés) de la ligne précédente?

**casefayere** · 23/08/2013, 14h33

je voulais savoir s'il était possible de conserver la mise en forme pour les lignes uniquement

Je ne comprends pas, car, apparemment, la mise en forme est conservée, après tout dépend de tes MFC

**John Parker** · 23/08/2013, 14h42

La mise en forme était conservée avec le premier code mais plus avec le second. C'est uniquement pour la copie des bordures en cas d'insertion de nouvelles lignes