Déplacement cellule au sein d'une colonne sous condition

[James Dean]

Bonjour Bonsoir, je me présente : James Dean.

J'essaie de programmer la chose suivante :
- Sélectionner une colonne (colonne B dans mon cas)
- Avancer de cellule en cellule
- Si une cellule est négative, alors rien ne se passe, cellule suivante
- Si une cellule est positive, alors elle se décale sur la cellule de droite

J'ai essayé avec une boucle while mais après de nombreuses tentatives, je viens vous demander de l'aide.
Voici le début de mon code :

Sub Test_WhileWend()
Dim i As Integer

i = 2

'Boucle sur les cellules de la colonne B
'On sort de la boucle si la cellule testée est <=0
While (Cells(i, 1)) <= 0 Then ActiveCell.Offset(1, 2).Select

Wend

End Sub

Cordialement et à très vite !

 

[dg62]

Bonjour
A tester

Sub test()
Dim derlig As Integer
Dim test As Integer
Dim i As Integer
derlig = Range("B65536").End(xlUp).Row
For i = 1 To derlig
test = Range("B" & i).Value
If test >= 0 Then
Range("C" & i) = test

End If
Next i

End Sub

 

[James Dean]

Merci pour votre réponse ! Je viens de tester mais la ligne "test = Range("B" & i).Value" semble ne pas fonctionner.
VBA m'indique
"Erreur d’exécution "13" et incompatibilité type"

 

[dg62]

combien avez-vous de valeurs à tester ?

 

[James Dean]

J'ai 54 valeurs à tester

 

[dg62]

Re,

 

[jmfmarques]

Bonjour
je me serais personnellement contenté de ceci :

Dim C As Range
For Each C In Columns(2).SpecialCells(xlConstants).Cells
   If C.Value > 0 Then C.Offset(, 1).Value = C.Value
Next

que l'on pourrait d'ailleurs également écrire ainsi par fainéantise (autre notation , interne)

Dim C As Range
For Each C In Columns(2).SpecialCells(xlConstants).Cells
   If C.Value > 0 Then C(1, 2).Value = C.Value
Next

 

[mapomme]

Bonjour à tous,

Une autre interprétation de "décaler". Le code est dans le module de la feuille "Feuil1".

 

[James Dean]

Bonjour
je me serais personnellement contenté de ceci :

Dim C As Range
For Each C In Columns(2).SpecialCells(xlConstants).Cells
   If C.Value > 0 Then C.Offset(, 1).Value = C.Value
Next

que l'on pourrait d'ailleurs également écrire ainsi par fainéantise (autre notation , interne)

Dim C As Range
For Each C In Columns(2).SpecialCells(xlConstants).Cells
   If C.Value > 0 Then C(1, 2).Value = C.Value
Next

Merci ! C'est quasiment ce que je voulais, n'est-il pas possible de supprimer les données qui, du coup, ont été copié ? Histoire de les avoir seulement à droite et non pas en double à gauche ?

 

[James Dean]

Bonjour à tous,

Une autre interprétation de "décaler". Le code est dans le module de la feuille "Feuil1".

Merci ! Mais du coup ce sont juste les 5 premières valeurs qui se décallent...

 

[James Dean]

Re,

C'est vrai que ça marche ici... Etrange

 

[dg62]

Sub test()
Dim derlig As Integer
Dim test As Integer
Dim i As Integer
derlig = Range("B65536").End(xlUp).Row
For i = 1 To derlig
test = Range("B" & i).Value
If test >= 0 Then
Range("C" & i) = test
Range("B" & i) = ""
End If
Next i

End Sub

 

[James Dean]

Sub test()
Dim derlig As Integer
Dim test As Integer
Dim i As Integer
derlig = Range("B65536").End(xlUp).Row
For i = 1 To derlig
test = Range("B" & i).Value
If test >= 0 Then
Range("C" & i) = test
Range("B" & i) = ""
End If
Next i

End Sub

PARFAIT, merci <3

 

[James Dean]

Merci à vous tous pour votre temps, vous êtes génial. A une prochaine !

 

[James Dean]

Peut-être me suis-je emballé un peu vite.
Mon code m'affiche erreur "13" à la ligne "test = Range("B" & i).Value".

Voici mon code en entier

Option Explicit
Sub Suivi_Bancaire()
'
'

'Supprimer la colonne moyenne de paiement
    Columns("C").Select
    Selection.ClearContents
    
' Les dernières colonnes inutiles
    Columns("H:I").Select
    Selection.ClearContents

    'Déplacer la colonne "Type de dépense"
    Columns("E:E").Select
    Selection.Cut Destination:=Columns("D:D")
    Columns("D:D").Select

'Sélection tableau
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$53"), , xlNo).Name = _
        "Tableau1"
    Range("Tableau1[[#Headers],[Colonne1]]").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("Tableau1[[#Headers],[Colonne2]]").Select
    ActiveCell.FormulaR1C1 = "Dépenses"
    Range("Tableau1[[#Headers],[Colonne3]]").Select
    ActiveCell.FormulaR1C1 = "Revenus"
    Range("Tableau1[[#Headers],[Colonne4]]").Select
    ActiveCell.FormulaR1C1 = "Débiteur"
    Range("Tableau1[[#Headers],[Colonne5]]").Select
    ActiveCell.FormulaR1C1 = "Types de Dépense"
     Range("Tableau1[[#Headers],[Colonne6]]").Select
    ActiveCell.FormulaR1C1 = "Types de Revenu"
    'Bonne taille des celules
    Columns("F:F").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit

' Déplacer les valeurs positives à droite
Dim derlig As Integer
Dim test As Integer
Dim i As Integer
derlig = Range("B65536").End(xlUp).Row
For i = 1 To derlig
test = Range("B" & i).Value
If test >= 0 Then
Range("C" & i) = test
Range("B" & i) = ""
End If
Next i

End Sub