Où est l'erreur?

[luke3300]

Bonjour à tous,

quelqu'un pourrait-il me dire pourquoi les données concernées par ce code se recopient-elles toujours sur la 2ème ligne de ma feuille BD?

J'ai pourtant appliqué le début et la fin d'un code qui fonctionne parfaitement sur un autre fichier mais sur celui-ci qui est du même genre, ça va pas.

Sub Transfert()
'

' Transfert Macro
'
Application.ScreenUpdating = False
'
i = 2

debut:
Sheets("BD").Select
If Range("A" & i) <> "" Then

    i = i + 1
    GoTo debut
    
Else
    Sheets("Formulaire").Select
    Range("B8").Select
    Selection.Copy
    Sheets("BD").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("B14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("B16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("B18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    ActiveSheet.Shapes("Drop Down 8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B19").Select
    Selection.Copy
    Sheets("BD").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("E10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("E12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("E14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("K2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("E16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("L2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("E18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("E20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("N2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("W2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("O2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("P2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("Q2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("R2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("S2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("H20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("U2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("B6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("BD").Select
    Range("V2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Formulaire").Select
    Range("A25").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-25
    Range("B6").Select

End If
    
End Sub

Je précise que tout le reste du code fonctionne, il n'y a que le fait que les données se recopient toujours sur la même ligne au lieu d'aller chaque fois à la suivante.

 

[porcinet82]

Re : Où est l'erreur?

Salut,

Je pense que l'erreur vient du fait que tu selectionnes toujours une cellule de la ligne 2 lorsque tu colles : Range("A2").Select puis Range("B2").Select ...
Dison en gros qu'il faudrait que tu mettes Range("A" & i).Select pour que ca fonctionne

Je me permet cependant quelques petites remarques que l'on m'a faites a mes débuts. Donc éviter au maximum les Select qui en général ne servent a rien, ainsi que les Goto.
Donc je te propose le code suivant qui devrait tres largement alléger ton code. Je te laisse le terminer, en cas de soucis, tu refais signes.

Sub Transfert()
Dim ligne_vide As Long, i As Integer, j As Integer
Application.ScreenUpdating = False
Sheets("BD").Select
ligne_vide = Sheets("BD").Range("A1").End(xlDown).Row + 1
j = 0
With Sheets("Formulaire")
    For i = 8 To 16 Step 2
        j = j + 1
        .Cells(i, 2).Copy
        Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
    .Range("B19").Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
 
[COLOR=seagreen]' pour la suite du code, il te suffit de copier/coller la boucle si dessus et [/COLOR]
[COLOR=seagreen]' d'adapter les numeros de colonnes de la copy et du paste. Celui de la [/COLOR]
[COLOR=seagreen]' copie en remplacant le 2 par le numero adequate de la copie et pour le [/COLOR]
[COLOR=seagreen]' paste, il te suffit d'initialiser le j juste avant la boucle. Pour la boucle suivante ce [/COLOR]
[COLOR=seagreen]'sera donc :[/COLOR]
[COLOR=seagreen]        'j=7[/COLOR]
[COLOR=seagreen]        'For ....
        '.Cells(i, 5).Cop<y[/COLOR]
[COLOR=seagreen]        ' ...[/COLOR]
 
End Sub

@+

 

[luke3300]

Re : Où est l'erreur?

Bonjour Porcinet 82,

et d'abord merci pour ta réponse.

Lorsque j'applique ton code, le débogueur de scripts m'indique une erreur à cette ligne:

 Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Pour le remplissage, je ne comprend pas très bien ...
Je suis vraiment novice en ce qui concerne les codes.

Pour que ce soit plus simple, je joins mon fichier et tu te rendras compte du support.

Grand merci d'avance.

 

[porcinet82]

Re : Où est l'erreur?

re,

Je viens de tester le code chez moi et il a l'air de fontionner, par contre je tourne sous Excel 2000 et pas 2007, donc peut etre est-ce la que ce situe le problème, meme si j'en doute.
Enfin le code fini donnerai ceci :

Sub Transfert()
Dim ligne_vide As Long, i As Integer, j As Integer
Application.ScreenUpdating = False
Sheets("BD").Select
ligne_vide = Sheets("BD").Range("A1").End(xlDown).Row + 1
j = 0
With Sheets("Formulaire")
    'copy de colonne B
    For i = 8 To 16 Step 2
        j = j + 1
        .Cells(i, 2).Copy
        Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
    .Range("B19").Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    'copy de colonne E
    j = 7
    For i = 8 To 20 Step 2
        j = j + 1
        .Cells(i, 5).Copy
        Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
     
    'copy de colonne H
    j = 14
    For i = 8 To 20 Step 2
        j = j + 1
        .Cells(i, 8).Copy
        Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
     
    .Range("B6").Copy
    Range("V2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("H6").Copy
    Range("W2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.ScreenUpdating = True
End Sub

Après, reste a savoir si ca fait bien ce que tu veux, le code ne fait pas d'erreur, mais bon...

@+

 

[luke3300]

Re : Où est l'erreur?

Merci Porcinet, je vais tester ça.

J'ai édité mon post précédent sur le temps que tu répondais, désolé.
Au moins, tu auras le fichier pour te rendre compte.

Merci encore, je teste ça.

 

[luke3300]

Re : Où est l'erreur?

Re,

je viens de tester le code et toujours le même problême avec le débogueur...

Que faire???

 

[porcinet82]

Re : Où est l'erreur?

re,

Est-ce que tu peux mettres le fichier en version .xls a la place de ton .xlsm car comme je te l'ai dits je taf sous Excel 2000. Si ca ne vient pas du fichier ou du code (i.e. si ca tourne sous 2000) j'irai essayer sur 2007 des que j'aurai acces au pc sur lequel il se trouve.

@+

 

[luke3300]

Re : Où est l'erreur?

Re,

bien sur le voici.

Désolé.

 

[porcinet82]

Re : Où est l'erreur?

re,

J'ai trouvé pourquoi ca merdait. En faite, ta feuille BD ne contient qu'une seule ligne. Du coup la ligne de code ligne_vide = Sheets("BD").Range("A1").End(xlDown).Row + 1 renvoie 65536 pour la variable ligne_vide et c'est ca qui fait merder la ligne en question. Mais meme en modifiant la ligne ca merdouillait encore et je ne sais pas trop pourquoi. Voici le code modifé pour que ca tourne :

Private Sub CommandButton1_Click()
Dim ligne_vide As Long, i As Integer, j As Integer
Application.ScreenUpdating = False
Sheets("BD").Select
ligne_vide = Sheets("BD").Range("A65536").End(xlUp).Row + 1
j = 0
With Sheets("Formulaire")
    'copy de colonne B
    For i = 8 To 16 Step 2
        j = j + 1
        .Cells(i, 2).Copy
        Sheets("BD").Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
    Sheets("BD").Range("B19").Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    'copy de colonne E
    j = 7
    For i = 8 To 20 Step 2
        j = j + 1
        .Cells(i, 5).Copy
        Sheets("BD").Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
     
    'copy de colonne H
    j = 14
    For i = 8 To 20 Step 2
        j = j + 1
        .Cells(i, 8).Copy
        Sheets("BD").Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
     
    .Range("B6").Copy
    Sheets("BD").Range("V2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("H6").Copy
    Sheets("BD").Range("W2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.ScreenUpdating = True
End Sub

@+

 

[luke3300]

Re : Où est l'erreur?

re,

cette fois c'est vrai que ça marche mieux mais il y a encore 4 celulles qui ne se transfèrent pas sur la feuille "BD".
Ce sont les 4 tout en bas du code, regarde:

Private Sub CommandButton1_Click()
Dim ligne_vide As Long, i As Integer, j As Integer
Application.ScreenUpdating = False
Sheets("BD").Select
ligne_vide = Sheets("BD").Range("A65536").End(xlUp).Row + 1
j = 0
With Sheets("Formulaire")
    'copy de colonne B
    For i = 8 To 16 Step 2
        j = j + 1
        .Cells(i, 2).Copy
        Sheets("BD").Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
    Sheets("BD").Range("B19").Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    'copy de colonne E
    j = 7
    For i = 8 To 20 Step 2
        j = j + 1
        .Cells(i, 5).Copy
        Sheets("BD").Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
     
    'copy de colonne H
    j = 14
    For i = 8 To 20 Step 2
        j = j + 1
        .Cells(i, 8).Copy
        Sheets("BD").Cells(ligne_vide, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
'Ce sont ces celulles-ci:

          *******
            
    .Range("B6").Copy
    Sheets("BD").Range("V2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("H6").Copy
    Sheets("BD").Range("W2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("B18").Copy
    Sheets("BD").Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("B19").Copy
    Sheets("BD").Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            *******

End With
Application.ScreenUpdating = True
End Sub

Qu'en penses-tu?

 

[porcinet82]

Re : Où est l'erreur?

re,

J'ai le cerveau encore en vacances dsl. Voici le code corrigé :

    .Range("B6").Copy
    Sheets("BD").Range("V" & ligne_vide).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("H6").Copy
    Sheets("BD").Range("W" & ligne_vide).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("B18").Copy
    Sheets("BD").Range("F" & ligne_vide).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("B19").Copy
    Sheets("BD").Range("G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Par contre il n'y a rien en B19 dans la feuille Formulaire, donc je suppose que tu t'es planté de cellule...

@+

 

[luke3300]

Re : Où est l'erreur?

re,

c'est normal Porcinet, c'est encore les vacances 🙂

Cette fois c'est au poil!!! Je me suis permis de rajouter " & ligne_vide" dans la parenthèses de la dernière ligne car le débogueur me signalait une erreur 🙂

Mais voilà, grâce à ton aide, j'y suis arrivé, merci beaucoup et bon après-midi.

PS: il y a bien qqe chose dans la celulle B19 mais c'est écrit en blanc.

Merci encore.