selectionner ligne

[romuald]

Bonjour, voila ma question.

Mon classeur contient 4 feuilles nommées:
Feuil1
fournisseur
client
option


Je souhaiterai selectionner sur la feuille tecnal toutes les lignes (sur la plages 0;4000) dont le cinquieme caractère de la cellule D est 9 pour les couper et les coller sur la feuille 1 a partir de la ligne2.

Merci d'avance

 

[romuald]

erreur ce n'est la feuille tecnal mais la feuille fournisseur

 

[porcinet82]

Salout Romuald,

Avec le code suivant tu devrais arriver à faire ce que tu souhaites :

Sub test()
Dim i%

Application.Goto Sheets('Feuil1').Range('A1')
For i = 4000 To 1 Step -1
    With Sheets('fournisseur')
        If .Cells(i + 1, 4).Value = '' Then .Rows(i + 1).Delete
        If Mid(.Cells(i, 4).Value, 5, 1) = 9 Then
            .Rows(i).Cut
            ad = Range('D65536').End(xlUp).Offset(1, 0).Row
            Rows(ad).Select
            ActiveSheet.Paste
        End If
    End With
Next i
End Sub

@+

 

[romuald]

merci porcinet82.

Ca marche nickel, mias pouurait tu me dire quelle modif je dois faire pour mettre la valeur 1 dans la cellule B des lignes que j'envoi sur la feuille1.

merci

 

[adon]

Salut romuald,

Pour ajouter la valeur '1' dans la cellule B des lignes que tu envois sur la feuil1, il faut que tu rajoute la ligne suivante entre 'ActiveSheet.Paste' et 'End If' :
Worksheets('feuil1').Cells(ad, 2) = 1

Ce qui donne ceci:

Sub test()
Dim i%

Application.Goto Sheets('Feuil1').Range('A1')
For i = 4000 To 1 Step -1
With Sheets('fournisseur')
If .Cells(i + 1, 4).Value = '' Then .Rows(i + 1).Delete
If Mid(.Cells(i, 4).Value, 5, 1) = 9 Then
.Rows(i).Cut
ad = Range('D65536').End(xlUp).Offset(1, 0).Row
Rows(ad).Select
ActiveSheet.Paste
Worksheets('feuil1').Cells(ad, 2) = 1
End If
End With
Next i
End Sub

Amicalement,
Adon

 

[romuald]

merci Adon ca marche

 

[romuald]

en fait dans les lignes que l'on envoi sur la feuille 1, il y a des valeur issu de formule, je voudrais faire un collage special pour garder que les valeurs, comment dois je faire dans le code??

 

[adon]

Re salut romuald,

J'ai fait un essai mais malheureusement ça n'a pas fonctionné parceque la macro Coupe/Colle une LIGNE. Et la fonction 'COLLAGE SPECIAL' ne fonctionne pas avec une ligne.

Sinon la solution aurait été de remplacer la ligne

ActiveSheet.Paste

par celle ci

ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

A mon avis il faudra que tu Coupe/Colle la plage de cellule dont tu as besoin pour que ça marche.


Amicalement,
Adon

 

[porcinet82]

Salut Romuald, Adon,

J'allais proposer la même solution qu'Adon, mais c'est vrai que ca pose un problème. En fait ce qui ne fonctionne pas, ce n'est pas le fait que ce soit une ligne, mais c'est la méthode couper/coller qui ne permet pas de faire un collage spécial. J'ai donc modifier la macro comme suit afin qu'elle fasse ce que tu souhaites.

Sub test()
Dim i%, ad%

Application.Goto Sheets('Feuil1').Range('A1')
For i = 12 To 1 Step -1
    With Sheets('fournisseur')
        If Mid(.Cells(i + 1, 4).Value, 5, 1) = 9 Then .Rows(i + 1).Delete
        If Mid(.Cells(i, 4).Value, 5, 1) = 9 Then
            .Rows(i).Copy
            ad = Range('D65536').End(xlUp).Offset(1, 0).Row
            Rows(ad).Select
            Selection.PasteSpecial Paste:=xlValues
        End If
        If i = 1 And Mid(.Cells(i, 4).Value, 5, 1) = 9 Then .Rows(i).Delete
    End With
Next i
End Sub

@+

 

[porcinet82]

re,

Par contre j'ai oublier la ligne de code que t'a proposé Adon pour la valeur 1 dans la cellule de la colonne B, je te laisse le soin de la rajouter.

@+

 

[ROMUALD]

merci ca marche, mais il fait faire copier au lieu de couper

 

[porcinet82]

re,

Oui je sais bien que ca fait un copier au lieu d'un coller, mais je t'ai expliquer la raison juste avant. Et comme de toutes manière dans mon code, j'ai mis ceci If Mid(.Cells(i + 1, 4).Value, 5, 1) = 9 Then .Rows(i + 1).Delete, le résultat est identique que ce soit un copier ou un coller puisque cette ligne signifie qu'il faut supprimer la ligne que l'on vient de coller.

@+

 

[adon]

à porcinet82:
Merci pour l'info(copier alp couper), ça pourra toujours servir ^_-

à romuald:
avec ma ligne ça donne ça

 Sub test()
Dim i%, ad%

Application.Goto Sheets('Feuil1').Range('A1')
For i = 12 To 1 Step -1
    With Sheets('fournisseur')
        If Mid(.Cells(i + 1, 4).Value, 5, 1) = 9 Then .Rows(i + 1).Delete
        If Mid(.Cells(i, 4).Value, 5, 1) = 9 Then
            .Rows(i).Copy
            ad = Range('D65536').End(xlUp).Offset(1, 0).Row
            Rows(ad).Select
            Selection.PasteSpecial Paste:=xlValues
            Worksheets('feuil1').Cells(ad, 2) = 1
        End If
        If i = 1 And Mid(.Cells(i, 4).Value, 5, 1) = 9 Then .Rows(i).Delete
    End With
Next i
End Sub

Mise à part ça romuald,
J'ai moi même levé le challenge de créer un super tableau pour ma boite alors que je n'y connaissais rien à VBA (je parle de ça il y a 15 jours), mais grâce à XLDnautes j'y suis arrivé et comme tu vois j'essais d'aider à mon tour les membres de ce forum.

Une dernière chose; l'enregistrement auto de macro est ton ami. Quand tu bute sur un problème de macro tu peux lancer l'enregistrement de macro automatique et en mettant tes fenêtre en mosaïc verticale, voir ce que tes actions donnent comme code VBA ^_-

Amicalement,
Adon