基于特定单元格条件将单元格从一列移动到另一列的VBA代码

我看到过一些关于使用VBA将单元格从一个工作簿移动到另一个工作簿或从一个工作表移动到另一个工作表的问题，但我希望根据特定条件将信息从同一工作表中的一列移动到另一列

我编写这段代码是为了将包含单词“save”的单元格从A列移动到同一工作表中的I列：

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

但是，虽然这个宏在我运行它时没有显示任何错误，但它似乎也没有做任何其他事情。不选择、剪切或粘贴任何内容。我在代码中哪里出错了

如果单元格包含“保存”一词，则将其从A列移至I列 在同一张纸上

您的代码不会执行类似的操作

要实现您的需求，您需要以下内容：

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

---

编辑

如果要将行的全部内容移到列

I

，只需替换代码的相关部分：

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

---

也许是这样的：

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

---

此代码向下扫描列，检测匹配项并执行复制。复制会带来格式和值

杰森，你的代码很完美，它完全按照我的要求移动了专栏。我完全忘了补充一点，如果列A中的值包含“save”，我需要将整行移到列I。因此，我需要剪切这些行，并将它们移到7列上，而不是将源代码留空。如果我可以修改你的代码，包括这一变化，这将是完美的。对不起，没有说得更具体一些@AnikaLeena-如果A列中的值包含“save”，我不确定您所说的我需要将整行移到I列是什么意思。您是说如果A包含“save”，您想将整行内容移到7个单元格上吗？是的，例如，如果A1包含“save”，B1包含一个数字，“save”将移到I1，B1中的数字将移到J1。谢谢，这太完美了！@Jason如果我想搜索所有列的值，而不是只搜索列A，你会如何将其应用到Sub中我为没有更具体而道歉，因为所有这些答案都很好，并且完全符合我在问题中的要求。当我将单元格的内容从A列移到I列时，我还需要将整行移到另一列。例如，如果A1中有单词“save”，B1中有数字8，则A1和B1都需要转换，以便“save”现在在I1中，8现在在J1中。我希望这有意义？这就是为什么我包含了“cell.EntireRow.cut”代码行。

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