VBA代码,用于根据特定的单元格标准将单元格从一列移动到另一列

时间:2015-02-05 16:33:26

标签: excel vba excel-vba range

我已经看到几个问题,询问是否使用VBA将单元格从一个工作簿移动到另一个工作簿或一个工作表到另一个工作表,但我希望根据特定条件将信息从一个列移动到另一个列。

我写了这段代码来移动A列中的单元格,如果它们在同一张纸中包含“保存”一词到第一列:

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

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

3 个答案:

答案 0 :(得分:2)

  

如果它们包含单词&#34,则从A列移动单元格;保存"到第一栏   在同一张表中

您的代码不会做这样的事情。

为了达到你的要求,你需要这样的东西:

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

答案 1 :(得分:1)

也许是这样的:

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

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

答案 2 :(得分:0)

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