pb de macro+déplacement de cellules

[klorane]

bonjour à tous,

Voilà j'utilise la macro suivante associée à un bouton :

Application.ScreenUpdating = False
Range('feuil2!B4').Insert Shift:=xlToRight
Range('feuil2!B4') = Range('feuil1!E4')
Application.ScreenUpdating = True

celle ci me copie la cellule E4 de la feuille1 dans la cellule B4 de la feuille 2 et me deplace le contenu de la cellule B4 de la feuille 2 dans la cellule B5 de la feuille 2 etc....

le soucis que j'ai c'est que je me retrouve avec un classement par ordre décroissant car la derniere valeur remplace l'ancienne en la plaçant à droite.
exemple 64 55 24 3 2 1

que faudrait il modifier pour que le classement se fasse dans l'ordre croissant? (que le dernier chiffre entré se place à droite de l'avant dernier chiffre pour se retrouver dans l'ordre croissant etc..).

1 2 3 24 55 64

Merci

Sylvain

 

[Bebere]

bonsoir Klorane

teste le bout de code qui suit

Sub Essai()
Dim C As String, MaVal, Plg As Range, Cel As Range
Application.ScreenUpdating = False
MaVal = Feuil1.Range('E4').Value
C = Feuil2.Range('B4').End(xlToRight).Address
Set Plg = Feuil2.Range('A4:' & C)
For Each Cel In Plg
If Cel.Value < MaVal And Cel.Offset(0, 1).Value > MaVal Then
Cells(Cel.Row, Cel.Column).Offset(0, 1).Insert Shift:=xlToRight
Cells(Cel.Row, Cel.Column).Offset(0, 1).Value = MaVal
End If
Next Cel
Application.ScreenUpdating = True
End Sub

à bientôt

 

[Charly2]

Bonsoir klorane, bonsoir Bebere

Une autre proposition :

Dim Cel As Range
Dim DecalageCol As Byte
'
Application.ScreenUpdating = False
Set Cel = Feuil2.Range('IV4').End(xlToLeft)
If Cel <> '' Then DecalageCol = 1
Cel.Offset(0, DecalageCol) = Feuil1.Range('E4')
Application.ScreenUpdating = True

Amicalement
Charly

 

[klorane]

Super!!! c'est se qu'il me fallait!

Merci à vous tous pour votre aide.

Sylvain