Probleme de selection de lignes sous VBA

Version imprimable

3 pièce(s) jointe(s)

Bonjour,

Je tente d'inserrer une ligne dans une worksheet, le sais que le code est tres simple car je l'ai utilise une vingtaine de fois dans ma base de donnee mais ici ce code ne semble plus fonctionner :

Je m'explique :

Voici mon code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 Private Sub CommandButton1_Click() 'Add a new engine ' Write a new engine ActiveSheet.Unprotect Range("8:8").Select If Range("C4").Value <> "" Then If Range("D4").Value <> "" Then Selection.Insert Shift:=xlDown Range("C4:D4").Select Selection.Copy Range("C8").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' ------------------ Writting in Complete list Sheets("COMPLETE LIST").Visible = True Sheets("COMPLETE LIST").Select ActiveSheet.Unprotect ' Document numbers writting loop ActiveSheet.Rows("8:8").Select Selection.Insert Shift:=xlDown Sheets("NEW ENGINE").Select Range("C4:D4").Select Selection.Copy Sheets("COMPLETE LIST").Select ActiveSheet.Range("C8").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Range("E8").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "BLUID SHEET" ActiveSheet.Range("F8").Select ActiveCell.FormulaR1C1 = "BS" ActiveSheet.Range("G8").Select ActiveCell.FormulaR1C1 = "1" ActiveSheet.Range("H8").Select ActiveCell.FormulaR1C1 = [C8] & "" & "-" & [F8] & "" & "-" & [G8] ActiveSheet.Range("I8").Select ActiveCell.FormulaR1C1 = "BUILD SHEET SUBSET" ActiveSheet.Range("H8").Select End sub
Lorsque je lance la macro en pas a pas ou normalement, la macro m'insere 4 lignes au lieu d'une et surtout a la mauvaise place.

Voici un imprime ecran de mon probleme :

Pièce jointe 152829

Je sais tres bien que la ligne de code ActiveSheet.Rows("8:8").Select ne selectionne que les lignes allant de la ligne 8 a 8, donc seulement la ligne 8. Si j'avais vraiment voulu selectionner ce qu'il y a dans mon imprime ecran j'aurai mi ActiveSheet.Rows("5:8").Select.

Alors je comprends vraiment pas ce qui se passe.

Pourriez vous m'aider ?

Amicalement

05/08/2014, 09h47
Patrice740

Bonjour,

N'y aurait-il pas, par hasard, des cellules fusionnées ?

D'autre part, il faut éviter d'utiliser select, c'est généralement une source de problèmes supplémentaires.

Pour insére une ligne avant la ligne 8, tu peux écrire :

Code:

Range("8:8").Insert Shift:=xlDown

mais il vaut mieux :

Code:

Rows(8).Insert Shift:=xlDown
05/08/2014, 09h53
coco.on.off

Merci

Bonjour Patrice 740,

Non il n'y a aucune cellule fusionnee que ce soit dans la ligne 7 ou 8.

J'ai enleve le select et ecris la ligne de code comme vous l'avez fait et cela fonctionne, allez savoir pourquoi.
Je simplifierai mes lignes de code, comme vous me l'avez montre, par la suite.

Encore merci

Bonsoir le fil, bonsoir le forum,

Pour moi il manque deux End If dans le code. Je les ai placé à la fin mais je doute que ce soit le bon endroit... Ton code sans Select :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub CommandButton1_Click()
'Add a new engine
 
' Write a new engine
ActiveSheet.Unprotect
 
If Range("C4").Value <> "" Then
    If Range("D4").Value <> "" Then
        Rows(8).Insert Shift:=xlDown
        Range("C4:D4").Copy
        Range("C8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        ' ------------------ Writting in Complete list
        With Sheets("COMPLETE LIST")
            .Visible = True
            .Unprotect
            ' Document numbers writting loop
            .Rows("8:8").Insert Shift:=xlDown
        End With
        With Sheets("NEW ENGINE")
            .Range("C4:D4").Copy
            Sheets("COMPLETE LIST").Range("C8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            .Range("E8").FormulaR1C1 = "BLUID SHEET"
            .Range("F8").FormulaR1C1 = "BS"
            .Range("G8").FormulaR1C1 = "1"
            .Range("H8").FormulaR1C1 = [C8] & "" & "-" & [F8] & "" & "-" & [G8]
            .Range("I8").FormulaR1C1 = "BUILD SHEET SUBSET"
            .Range("H8").Select
        End With
    End If
End If
End Sub