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

我已经看到了几个问题，询问如何使用VBA将单元格从一个工作簿移动到另一个工作表或另一个工作表，但是希望基于特定条件将信息从一列移动到另一列。

我编写了这个代码来移动列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 

但是，虽然这个macros在运行时没有显示任何错误，但是它也没有做太多的事情。 没有select，剪切或粘贴。 代码中哪里出错了？

Answer 1

如果在同一张表中包含单词“保存”到列I，则从列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开始，只需要replace相关的代码部分：

 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 

Answer 2

也许是这样的：

 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 

此代码扫描列，检测匹配并执行复制。 复制带来的格式以及价值。

Answer 3

 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