Code VBA pour déplacer des cellules d'une colonne à l'autre en fonction de critères spécifiques de cellules

J'ai vu plusieurs questions à poser à propos du déplacement des cellules d'un classeur à l'autre ou d'une feuille à l'autre à l'aide de VBA, mais je suis dans l'espoir de faire de l'information d'une colonne à l'autre, dans la même feuille en fonction de critères spécifiques.

J'ai écrit ce code pour déplacer les cellules de la colonne A si ils contenaient le mot "enregistrer" à la colonne I de la même feuille:

Sub Findandcut()
    Dim rngA As Range
    Dim cell As Range

    Set rngA = Sheets("Jan BY").Range("A2:A1000")
    For Each cell In rngA
        If cell.Value = "save" Then
            cell.EntireRow.Cut
            Sheets("Jan BY").Range("I2").End(xlDown).Select
            ActiveSheet.Paste
        End If
    Next cell

End Sub

Mais, tandis que cette macro ne pas afficher les erreurs lorsque je le lance, il ne semble pas faire grand-chose d'autre, soit. Rien n'est sélectionné, couper ou coller. Où dans le code, j'ai fait de mal?

Mes excuses pour ne pas être plus précis, depuis toutes ces réponses sont excellentes et faire exactement ce que j'ai demandé dans la question. Lorsque je déplace le contenu des cellules de la colonne A à la colonne I, j'ai aussi besoin de changer l'intégralité de la ligne plus de. Ainsi, par exemple, si j'ai le mot "enregistrer" en A1, et le numéro 8 en B1, à la fois A1 et B1 doivent être changées de sorte que "enregistrer" est maintenant en I1 et 8 est maintenant en J1. J'espère que cela a un sens? c'est pourquoi j'ai inclus la "cellule.EntireRow.couper la" ligne de code.

InformationsquelleAutor Anika Leena | 2015-02-05

2

déplacer les cellules de la colonne A si ils contenaient le mot "enregistrer" à la colonne I
dans la même feuille

Votre code ne fait rien comme cela.

Pour accomplir vos besoins, vous avez besoin de quelque chose comme ceci:
```
Sub Findandcut()
    Dim row As Long

    For row = 2 To 1000
        ' Check if "save" appears in the value anywhere.
        If Range("A" & row).Value Like "*save*" Then
            ' Copy the value and then blank the source.
            Range("I" & row).Value = Range("A" & row).Value
            Range("A" & row).Value = ""
        End If
    Next

End Sub
```
Modifier

Si vous souhaitez modifier la totalité du contenu de la ligne jusqu'à ce qu'il commence à la colonne I, il suffit de remplacer l'article pertinent du code:
```
If Range("A" & row).Value Like "*save*" Then
    ' Shift the row so it starts at column I.
    Dim i As Integer
    For i = 1 To 8
        Range("A" & row).Insert Shift:=xlToRight
    Next
End If
```
- Jason, votre code a été parfait, et il a déplacé la colonne plus exactement comme je le voulais. J'ai complètement oublié d'ajouter que j'ai besoin de déplacer l'ensemble de la ligne à la colonne I si la valeur de la colonne A contient "enregistrer". Ainsi, au lieu d'occulter la source j'ai besoin de couper ces lignes et de les déplacer de plus de 7 colonnes. Si je peux modifier votre code pour inclure cette modification, il serait parfait. Désolé de ne pas être plus précis!
- Je ne suis pas sûr de ce que tu veux dire par j'ai besoin de déplacer l'ensemble de la ligne à la colonne I si la valeur de la colonne A contient "enregistrer". vous dites que vous voulez déplacer la totalité du contenu de la ligne de plus de 7 cellules si A contient "enregistrer"?
- Voir mise à jour de réponse.
- Oui, donc, si, par exemple, A1 contient "enregistrer" et B1 contient un certain nombre, "enregistrer" serait déplacé sur I1 et le nombre de B1 serait déplacé à J1.
- Merci, c'est parfait!
InformationsquelleAutor Jason Faulkner

Peut-être quelque chose comme:

Sub Findandcut()
    Dim rngA As Range
    Dim cell As Range

    Set rngA = Sheets("Jan BY").Range("A2:A1000")
    For Each cell In rngA
        If cell.Value = "save" Then
            cell.Copy cell.Offset(0, 8)
            cell.Clear
        End If
    Next cell

End Sub

Ce code scans en bas de la colonne, détecte les matches, et effectue la copie. La copie apporte plus de la format ainsi que de la valeur.

InformationsquelleAutor Gary's Student

Sub Findandcut()
    Dim rngA As Range
    Dim cell As Range

    Set rngA = Sheets("Jan BY").Range("A2:A1000")
    For Each cell In rngA
        If cell.Value = "save" Then
            Sheets("Jan BY").Range("I" & Rows.Count).End(xlUp).Select
            Selection.Value = cell.Value
            cell.Delete Shift:=xlUp
        End If
    Next cell

End Sub

InformationsquelleAutor RAJA THEVAR

Vous devez vous connecter pour publier un commentaire.