Pb de code VBA - Coller ligne

[JORDAN]

Bonjour le Forum,

Voici mon problème :
Le code ci-dessous me permet de copier puis de coller des données. Mon 1er coller s'effectue
cells(10,1) et les suivants viennent dessous, mon soucis c'est que le 2ème coller vient bien cells(11,1) mais le 3ème coller efface le 2ème, il ne va pas cells(12,1)...

Merci pour vos infos

A+

Dim i As Byte

Application.Goto Sheets('RESULTAT').Range('A1')
For i = 1 To Range('C65536').End(xlUp).Row
    If Cells(i, 3).Value = NomFeuille Then
        Range('A' & i & ':B' & i & ',D' & i).Select
        Selection.Copy
        Application.Goto Sheets(NomFeuille).Range('A9')
        If Sheets(NomFeuille).Cells(10, 1).Value = '' Then
            Sheets(NomFeuille).Cells(10, 1).Select
            ActiveSheet.Paste
            Sheets('RESULTAT').Select
        Else
            [color=#0000FF]Selection.End(xlDown).Select
            Selection.Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets('RESULTAT').Select[/color]
        End If
    End If
Next i

 

[Jacques87]

Bonjour Jordan

Il me semble que le test se fait toujours à partir de la cellule Cell(10,1)

If Sheets(NomFeuille).Cells(10, 1).Value = '' Then
Sheets(NomFeuille).Cells(10, 1).Select
ActiveSheet.Paste
Else
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste

et dans le cas où le résultat est négatif tu demandes un déplacement d'une ligne vers le bas
Selection.Offset(1, 0).Select

mais ce déplacement s'effectue à partir de la sélection, soit Cell(10,1), donc tu vas en Cell(11,1)
A voir de plus près

Bon courage

 

[JORDAN]

Bonjour Jacques87,

Le problème est bien là, mais comment faire pour éviter cela sachant que les lignes 50 et 51 sont occupées et que de la ligne 10 à 49 c'est libre pour coller les lignes.

Merci

 

[Jacques87]

Re

Sans dénaturer ton idée et ta façon de procéder, je ferais un test de la ligne 10 à la ligne 49 pour savoir laquelle de ces lignes est la première disponible

For L = 10 to 49
If Sheets(NomFeuille).Cells(L, 1).Value = '' Then
Sheets(NomFeuille).Cells(L, 1).Select
ActiveSheet.Paste
Sheets('RESULTAT').Select
End If
Next L

Ce n'est certainement pas la méthode la plus noble mais elle devrait te donner satisfaction sans dénaturer ton écriture
A vérifier car je ne l'ai pas testée

Bon courage

Message édité par: Jacques87, à: 13/03/2006 15:22

 

[JORDAN]

Re,

C'est simple et comme tu le dis ça ne modifie pas le reste. Ca fonctionne correctement

Merci pour ta solution
A+