Note: The other languages of the website are Google-translated. Back to English

如何基于Excel中的单元格值将整行移动到另一张工作表?

为了根据单元格值将整行移动到另一张纸,本文将为您提供帮助。

使用VBA代码根据单元格值将整行移动到另一张工作表
使用Kutools for Excel根据单元格值将整行移动到另一张工作表


使用VBA代码根据单元格值将整行移动到另一张工作表

如下面的屏幕截图所示,如果在C列中存在一个特定的单词“ Done”,则需要将整个行从Sheet1移到Sheet2。您可以尝试以下VBA代码。

1。 按 其他+ F11 同时打开 Microsoft Visual Basic应用程序 窗口。

2.在“ Microsoft Visual Basic for Applications”窗口中,单击“ 插页 > 模块。 然后将下面的VBA代码复制并粘贴到窗口中。

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

备注:在代码中, Sheet1 工作表包含您要移动的行。 和 Sheet2 是您将在其中找到行的目标工作表。 “C:C”是包含特定值的列,而单词“完成 ”是您将基于其移动行的特定值。 请根据您的需要进行更改。

3。 按 F5 键运行代码,然后将满足Sheet1中条件的行立即移至Sheet2。

备注:上面的VBA代码将移至指定的工作表后从原始数据中删除行。 如果只想基于单元格值复制行而不是删除它们。 请应用下面的VBA代码2。

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

使用Kutools for Excel根据单元格值将整行移动到另一张工作表

如果您是VBA代码的新手。 在这里我介绍 选择特定的单元格 实用程序 Kutools for Excel。 使用此实用程序,您可以轻松地基于工作表中的某个单元格值或不同的单元格值选择所有行,然后根据需要将所选行复制到目标工作表中。 请执行以下操作。

申请前 Kutools for Excel首先下载并安装.

1.选择包含要作为行依据的单元格值的列列表,然后单击 库工具 > 选择 > 选择特定的单元格。 看截图:

2.在开幕 选择特定的单元格 对话框,选择 整行 ,在 选择类型 部分,选择 等于 ,在 特定类型 下拉列表,在文本框中输入单元格值,然后单击 OK 按钮。

另一个 选择特定的单元格 弹出对话框,显示选定的行数,同时,选定行中包含指定值的所有行均已选中。 看截图:

3。 按 按Ctrl + C 键复制选定的行,然后将其粘贴到所需的目标工作表中。

备注:如果要基于两个不同的单元格值将行移动到另一个工作表。 例如,根据“ Done”或“ Processing”单元格值移动行,您可以启用 Or 条件 选择特定的单元格 对话框如下图所示:

  如果您想免费试用(30-day) 这个实用程序, 请点击下载,然后按照上述步骤进行操作。


相关文章:


最佳办公效率工具

Kutools for Excel解决了您的大多数问题,并使您的生产率提高了80%

  • 重用: 快速插入 复杂的公式,图表 以及您以前使用过的任何东西; 加密单元 带密码 创建邮件列表 并发送电子邮件...
  • 超级公式栏 (轻松编辑多行文本和公式); 阅读版式 (轻松读取和编辑大量单元格); 粘贴到过滤范围...
  • 合并单元格/行/列 不会丢失数据; 拆分单元格内容; 合并重复的行/列...防止细胞重复; 比较范围...
  • 选择重复或唯一 行; 选择空白行 (所有单元格都是空的); 超级查找和模糊查找 在许多工作簿中; 随机选择...
  • 确切的副本 多个单元格,无需更改公式参考; 自动创建参考 到多张纸; 插入项目符号,复选框等...
  • 提取文字,添加文本,按位置删除, 删除空间; 创建和打印分页小计; 在单元格内容和注释之间转换...
  • 超级滤镜 (将过滤方案保存并应用于其他工作表); 高级排序 按月/周/日,频率及更多; 特殊过滤器 用粗体,斜体...
  • 结合工作簿和工作表; 根据关键列合并表; 将数据分割成多个工作表; 批量转换xls,xlsx和PDF...
  • 超过300种强大功能. 支持 Office / Excel 2007-2021 和 365。支持所有语言。 在您的企业或组织中轻松部署。 完整功能 30 天免费试用。 60 天退款保证。
kte选项卡201905

Office选项卡为Office带来了选项卡式界面,使您的工作更加轻松

  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,发布者,Access,Visio和Project。
  • 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
  • 每天将您的工作效率提高50%,并减少数百次鼠标单击!
officetab底部
按评论排序
注释 (299)
还没有评分。 成为第一位评论!
该评论由网站上的主持人最小化
你好,我发现这个特别的指南比我见过的其他指南更有帮助。 谢谢! 我遇到的麻烦是,如果我将所需的值更改为“已关闭”,我必须运行 F5 来移动该行。 我希望它自动移动。 我是 Excel 新手,非常感谢您的帮助。 Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("ECR Incident Tracker").UsedRange.Rows.Count J = Worksheets("Resolved Issues").UsedRange.Rows。计数 If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Resolved Issues").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("ECR Incident Tracker").Range("B1:B" & I) On Error Resume Next Application.ScreenUpdating = False For Each xCell In xRg If CStr(xCell.Value) = "Closed" Then xCell.EntireRow.Copy Destination:=Worksheets("Resolved Issues").Range("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
该评论由网站上的主持人最小化
您好,我正在尝试自动移动单元格,而无需打开模块并按 F5。 你有没有解决过这个问题? 先感谢您!
该评论由网站上的主持人最小化
Crystal 提供了有关如何执行此操作的信息 - 请查看此线程的第一页以查看她的回复。 它会自动将列中具有今天日期的行(在我的情况下为 L)移动到不同的工作表。
该评论由网站上的主持人最小化
我正在运行此代码并尝试根据 I 列中出现的今天日期移动一行 - 我已将 Range("B1:B" & I) 更改为读取 Range(I1:I" & I) 。我已更改“完成”在您的示例中到日期。但是,当今天的日期出现在行中的任何位置时,而不仅仅是根据需要在 I 列中,该行将移动到备用工作表。知道为什么会发生这种情况以及如何让行移动仅当今天的日期在第一列时,不管今天的日期是否出现在其他列中?
该评论由网站上的主持人最小化
如果我想有许多值和许多表来移动我的行,我将不得不为该单元格再次编写整个代码并使用不同的值? 意思是,如果我把 NA 放在一个单元格中,它会转到 Na 表,如果我放 W#,它将转到错误的数字表等。
该评论由网站上的主持人最小化
嗨,这很有帮助。 有没有办法在不将数据行移动到第二张工作表的情况下执行此操作,而是将其复制? 那么数据会保留在两张纸上吗?
该评论由网站上的主持人最小化
嗨,代码非常有帮助,但是我不需要复制整行,而是需要将特定的行选择移动到下一张纸。 我如何定义一个范围而不是整行 Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets(" Sheet2").UsedRange.Rows.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Sheet1").Range( "C1:C" & I) On Error Resume Next Application.ScreenUpdating = False For Each xCell In xRg If CStr(xCell.Value) = "Done" Then xCell.整行.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
该评论由网站上的主持人最小化
如果我想将行(特定单元格)复制到另一张表到特定单元格,代码是什么? 但也基于一个值示例: 彩色产品图像字符串 白色搅拌机 2 whiteblender2 黑色榨汁机 3 blackjuicer3 red tv1 redtv1 green iron 4 greeniron4 我想将字符串复制到另一张纸上,但图像列中的数字告诉它应该复制多少次(因此,在这种情况下,搅拌机字符串应该复制成 2 行
该评论由网站上的主持人最小化
嗨,非常好的一段代码,工作得很好。 如何更改此代码以将行从一个表移动到另一个表,而不是一张表移动到另一张表? 非常感谢 !
该评论由网站上的主持人最小化
嗨,我正在尝试使用代码,但在 Dim xCell As Range 上收到语法错误。 你能帮忙吗?
该评论由网站上的主持人最小化
Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets("Sheet2").UsedRange.Rows.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Sheet1").Range("C1:C" & I) On Error Resume Next Application.ScreenUpdating = False For Each xCell In xRg If CStr(xCell.Value) = "Done" Then xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub 如何添加第二个工作表以将行移动到 sheet2?
该评论由网站上的主持人最小化
如果我想包含任何日期作为我的值,我应该输入什么? 因此,如果该行没有日期,则该行保留在工作表 1 上,如果有,则移动到工作表 2?
该评论由网站上的主持人最小化
[quote]嗨,这很有帮助。 有没有办法在不将数据行移动到第二张工作表的情况下执行此操作,而是将其复制? 那么数据会保留在两张纸上吗?通过麦迪[/quote] 有没有人解决这个问题
该评论由网站上的主持人最小化
从代码中删除此“xCell.EntireRow.Delete”
该评论由网站上的主持人最小化
当我删除那行代码并再次运行宏时,Excel 冻结。 为什么以及如何解决? 我希望数据在两个工作表上,而不是从原始数据中删除。 TIA
该评论由网站上的主持人最小化
有答案吗? 我的也冻结了我想复制但不删除该行
该评论由网站上的主持人最小化
美好的一天,
下面的 VBA 代码可以帮助您只复制行而不是删除它们。

子奶酪()
将 xRg 调暗为范围
将 xCell 调暗为范围
暗淡我只要
昏暗J只要
暗K只要
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
如果 J = 1 那么
如果 Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 那么 J = 0
结束如果
设置 xRg = Worksheets("Sheet1").Range("C1:C" & I)
出错时继续下一步
Application.ScreenUpdating = False
对于 K = 1 到 xRg.Count
如果 CStr(xRg(K).Value) = "Done" 那么
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
结束如果
下一个
Application.ScreenUpdating =真
END SUB
该评论由网站上的主持人最小化
嗨,我正在寻找这方面的变化。 我需要脚本连续运行,或者每当该特定字段中的值发生变化时运行失败。 代码本身可以工作,但需要独立运行。 我希望它是自动化的。 有人可以帮忙吗?

顺便说一句,如果我只希望它复制范围内的特定单元格,那是如何实现的?
该评论由网站上的主持人最小化
亲爱的罗伯,

如果您需要在该字段中的单元格更改时自动运行脚本,下面的 VBA 代码可以帮助您。 请右键单击当前工作表(您将自动移动行的工作表)选项卡,然后从上下文菜单中选择查看代码。 然后将下面的 VBA 脚本复制并粘贴到代码窗口中。

私人子Worksheet_Change(按目标的ByVal目标)

将 xCell 调暗为范围

暗淡我只要
出错时继续下一步

Application.ScreenUpdating = False

设置 xCell = 目标(1)
如果 xCell.Value = "完成" 那么
I = Worksheets("Sheet2").UsedRange.Rows.Count
如果我 = 1 那么

如果 Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 那么 I = 0

结束如果

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
结束如果

Application.ScreenUpdating =真

END SUB


对于第二个问题,您的意思是只复制几个单元格而不是整行? 或者您能否提供您问题的屏幕截图? 谢谢!

最好的问候,水晶
该评论由网站上的主持人最小化
水晶,


你的帮助比需要的更多:)



我们如何在这里添加另一个条件,例如我想在 Done 旁边传输 Completed:


私人子Worksheet_Change(按目标的ByVal目标)

将 xCell 调暗为范围

暗淡我只要
出错时继续下一步

Application.ScreenUpdating = False

设置 xCell = 目标(1)
如果 xCell.Value = "完成" 那么
I = Worksheets("Sheet2").UsedRange.Rows.Count
如果我 = 1 那么

如果 Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 那么 I = 0

结束如果

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
结束如果

Application.ScreenUpdating =真

END SUB
该评论由网站上的主持人最小化
嗨水晶
这是我在网上找到的最有用的信息,这个宏可以满足我的需求。 但是我正在将行从一个表移动到另一个表 - 使用这个宏,信息会移动到表外的第一个空闲行,而不是表中的下一个空闲行? 你能帮我吗?
该评论由网站上的主持人最小化
我正在运行此代码并尝试根据 I 列中出现的今天日期移动一行 - 我已将 Range("B1:B" & I) 更改为读取 Range(I1:I" & I) 。我已更改“完成”在您的示例中到日期。但是,当今天的日期出现在行中的任何位置时,而不仅仅是根据需要在 I 列中,该行将移动到备用工作表。知道为什么会发生这种情况以及如何让行移动仅当今天的日期在第一列时,不管今天的日期是否出现在其他列中?
该评论由网站上的主持人最小化
亲爱的大卫,

在将范围和变量值更改为迄今为止,该代码对我来说效果很好。 代码中的日期格式必须与您在工作表中使用的日期格式相匹配。 还是方便您附上工作表?
该评论由网站上的主持人最小化
嗨水晶,


当您说代码和电子表格日期格式必须匹配时,我不清楚您的意思-我不是 VB 专家,更多的是新手级别。 在我的电子表格中,我在 F 列中输入今天的日期作为该行的输入日期,格式为 ctrl + :。 我以 mm/dd/yyyy 格式在“I”列中输入到期日期。 但是,这会导致在输入新行并在 F 列中输入今天的日期时出现问题,因为一旦输入,该行就会移动到新工作表中。此外,不会出现在打开工作簿时运行的附加代码在没有我强迫的情况下运行。 很抱歉对您来说可能是非常微不足道的问题,但我无法听到这些问题。 任何帮助,将不胜感激。
该评论由网站上的主持人最小化
亲爱的大卫,

我已经完全按照您上面提到的方法进行了尝试,但问题并未出现在我的案例中。 你能提供你的Excel版本吗? 我需要更多信息来帮助解决这个问题。 很抱歉又给您添麻烦了。

最好的问候,水晶
该评论由网站上的主持人最小化
水晶,这些是相关的工作表。 您将在复制的代码中看到我在 L 列中搜索“最多”今天的日期,如果“最多”并包括今天的日期在该列中,那么我想将包含该日期的行移动到新的工作表。 目前,当我在行中的任意位置输入今天的日期时(例如,如果今天发出请求,则在 F 列)它会自动将整行移动到存档的电子表格中。 我通常使用 ctrl + : 组合输入今天的日期,通常在 F 列中。
此外,我希望在打开工作簿时进行此操作。 目前我需要去显示代码然后按 F5。 欢迎任何有关如何做到这一点的建议。
该评论由网站上的主持人最小化
不幸的是,我的启用宏的工作簿不会上传,因为它说格式不支持。 这些在 Excel 2016 中
该评论由网站上的主持人最小化
亲爱的大卫,

下面的 VBA 代码可以帮助您实现它。

私有子 Workbook_Open()
将 xRg 调暗为范围
将 xCell 调暗为范围
暗淡我只要
昏暗J只要
I = Worksheets("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count
J = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count
如果 J = 1 那么
如果 Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 那么 J = 0
结束如果
设置 xRg = Worksheets("CURRENT OASIS OPPORTUNITIES").Range("L1:L" & I)
出错时继续下一步
Application.ScreenUpdating = False
对于 xRg 中的每个 xCell
如果 CStr(xCell.Value) = 日期 那么
xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
结束如果
下一个
END SUB

笔记:
1.需要将VBA脚本放入ThisWorkbook代码窗口;
2. 您的工作簿需要保存为 Excel 启用宏的工作簿。

完成上述操作后,每次打开工作簿时,如果 L 列中的单元格到达今天的日期,则会将整行移动到 ARCHIVED 工作表中。

野兽的问候,水晶
该评论由网站上的主持人最小化
谢谢水晶,
如果在 L 列中实现了今天的日期,这将非常有用。有没有办法在 L 列中也包含截至今天的日期,这样如果我几天不检查工作簿,它将自动包含之前的更早日期今天的? 非常感谢您的帮助。
该评论由网站上的主持人最小化
亲爱的大卫,

抱歉,我不确定我是否收到您的问题。 如果是这样,只要较早的日期出现在 L 列中,所有行都会被移动?
该评论由网站上的主持人最小化
嗨水晶,

如果我几天没有打开我的工作表并且在 L 列中输入的日期现在已经过去,即 L 列中单元格中的日期是 11 年 2017 月 13 日,但直到 XNUMX 月 XNUMX 日才打开我的工作表,我会就像要检查直到今天为止的每个日期的 L 列中的所有条目,然后将相应的行移动到新工作表。 目前,使用您慷慨提供的代码,只有 L 列中当前日期的行被移动到新工作表中,而 L 列中日期较早的行被移动到新工作表中,我目前手动将其移动到新工作表中。 谢谢你的帮助。
该评论由网站上的主持人最小化
亲爱的大卫,



我明白你的意思。 请尝试以下 VBA 脚本。 打开工作簿时,L 列中日期到今天日期的所有行都将移动到新的指定工作表。



私有子 Workbook_Open()
将 xRg 调暗为范围
将 xRgRtn 调暗为范围
将 xCell 调暗为范围
将 xLastRow 变暗
暗淡我只要
昏暗J只要
出错时继续下一步
xLastRow = Worksheets("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count
如果 xLastRow < 1 则退出 Sub
J = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count
如果 J = 1 那么
如果 Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 那么 J = 0
结束如果
设置 xRg = Worksheets("CURRENT OASIS OPPORTUNITIES").Range("L1:L" & xLastRow)
对于 I = 2 到 xLastRow
If xRg(I).Value > Date Then Exit Sub
如果 xRg(I).Value <= 日期 那么
xRg(I).EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
xRg(I).EntireRow.删除
J = J + 1
我 = 我 - 1
结束如果
下一个
END SUB

您需要将 VBA 脚本放入 ThisWorkbook 代码窗口,并将工作簿另存为 Excel 启用宏的工作簿。
该评论由网站上的主持人最小化
谢谢水晶,这工作得很好。
该评论由网站上的主持人最小化
水晶,我有点仓促地回应代码有效。 我今天打开了我的工作簿,在 L 列单元格中包含先前日期条目的行仍然在“当前的绿洲机会工作表”中,并且没有按预期移动到“存档的绿洲工作表”。 任何想法为什么会这样?
该评论由网站上的主持人最小化
就上述问题而言,突出显示的单元格位于 L 列中,并且是将行移动到新工作表的标准(截至今天)。 希望这张图片有帮助。
该评论由网站上的主持人最小化
这也是与上述相关的VBA窗口的副本。
该评论由网站上的主持人最小化
水晶,我有点仓促地回应代码有效。 我今天打开了我的工作簿,在 L 列单元格中包含先前日期条目的行仍然在“当前的绿洲机会工作表”中,并且没有按预期移动到“存档的绿洲工作表”。 任何想法为什么会这样?
该评论由网站上的主持人最小化
水晶,

由于我无法上传我的工作簿,我将在此处重现行和列

ABCDEFGHIJKL
# 类型预留征求修改 # 发布日期问题 客户交付地点 项目提案到期

1 SS SB 1234567 1 09/6/17 没有军队名称 Place Drive Tank 09/10/17

使用下面的代码,我希望它在 L 列到达今天的日期时将整行移动到新工作表。 此外,如果我已经好几天没有完成工作表,我希望它在 L 列中使用“截至今天”搜索来做同样的事情。 如果可能的话,我还希望它在我打开工作簿时自动执行此操作。 目前,如果我在行中的任何单元格中输入今天的日期,例如输入数据时的列 F,整行将移至存档工作表。 (使用 Excel 2016)

[模块 1 代码]

子 DaveV()

将 xRg 调暗为范围

将 xCell 调暗为范围

暗淡我只要

昏暗J只要

I = Worksheets("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count

J = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count

如果 J = 1 那么
如果 Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 那么 J = 0

结束如果

设置 xRg = Worksheets("CURRENT OASIS OPPORTUNITIES").Range("L1:L" & I)

出错时继续下一步

Application.ScreenUpdating = False

对于 xRg 中的每个 xCell

如果 CStr(xCell.Value) = 日期 那么

xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
xCell.EntireRow.Delete

J = J + 1
结束如果

下一个
Application.ScreenUpdating =真

END SUB
该评论由网站上的主持人最小化
[表 1 代码]

私人子Worksheet_Change(按目标的ByVal目标)
将 xCell 调暗为范围
暗淡我只要
出错时继续下一步
Application.ScreenUpdating = False
设置 xCell = 目标(1)
如果 xCell.Value = 日期 那么
I = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count
如果我 = 1 那么
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Then I = 0 End If
xCell.EntireRow.Copy Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & I + 1)
xCell.EntireRow.Delete
结束如果
Application.ScreenUpdating =真
END SUB

希望以上内容有所帮助,但我不是 VBA 人员,因此不明白如何使代码完成我需要的工作。 您的帮助将不胜感激。
该评论由网站上的主持人最小化
你的脚本有一个大错误!

假设您检测到第 7 行在 C 列中有“完成”一词,因此您复制它并删除该行。
删除该行后,列表中的下一行将是第 9 行而不是第 8 行,因为一旦删除了第 7 行,现在第 8 行内容在第 7 行,所有行都上升了 1 行。 所以要检查的下一行应该是第 8 行,但现在它包含了以前在第 9 行上的数据,所以每次你删除一行时,你实际上是在跳过一行来检查!!!
该评论由网站上的主持人最小化
亲爱的肖阿隆,

感谢您的评论。 代码已更新,错误已修复。 非常感谢你的助手。

最好的问候,水晶
该评论由网站上的主持人最小化
我认为这发生在我身上,即使它说代码已更新,它也会一遍又一遍地复制同一行。 这就是我所拥有的:

子奶酪()
'由 Kutools for Excel 更新 2017/8/28
将 xRg 调暗为范围
将 xCell 调暗为范围
暗淡我只要
昏暗J只要
暗K只要
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
如果 J = 1 那么
如果 Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 那么 J = 0
结束如果
设置 xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
出错时继续下一步
Application.ScreenUpdating = False
对于 K = 1 到 xRg.Count
如果 CStr(xRg(K).Value) = "Yes" 那么
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.删除
如果 CStr(xRg(K).Value) = "Yes" 那么
K = K - 1
结束如果
J = J + 1
结束如果
下一个
Application.ScreenUpdating =真
END SUB
该评论由网站上的主持人最小化
嗨,弗雷德,
每次运行代码时,代码都会搜索指定的范围,因此它会一遍又一遍地复制同一行,因为它无法判断哪一行已被复制。 为避免重复复制同一行,您可以在指定单元格中输入匹配值时自动运行代码。
在名为“采购预测”的工作表中,右键单击工作表选项卡,然后单击 查看代码 从上下文菜单中。 然后在Sheet(代码)窗口中复制下面的VBA代码。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 20220830
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Yes" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Yes" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
该评论由网站上的主持人最小化
有人可以帮我完成这项工作吗? 我试图更改需要与我的文件匹配的部分,但这出现了,我不知道该怎么做。
该评论由网站上的主持人最小化
当我尝试上传 excel 文件时,它说文件不支持。 抱歉……今天为此苦苦挣扎。
该评论由网站上的主持人最小化
我想要类似任务的帮助,但略有不同。 我有 5 列数字,每列大约 25000,每列的标题为 1-5。如果第 1 列的值大于零,或者第 2 列大于零,我想将整行复制到另一张纸上,或第 3 列小于零,或第 4 列大于 5,或第 XNUMX 列大于 XNUMX,等等。这可能吗?
该评论由网站上的主持人最小化
图片上传不工作......对不起。
该评论由网站上的主持人最小化
你好,
请使用这个的上传按钮。
查看附件 (1 / 5)
该评论由网站上的主持人最小化
因此,目的是查看是否有任何气体超过了我将在公式中设置的限制,将整个鱼卵复制到一张新纸上。

非常感谢您的帮助。
该评论由网站上的主持人最小化
附上图片
查看附件 (1 / 5)
该评论由网站上的主持人最小化
亲爱的迈克尔,
也许您可以通过使用 Excel 加载项来解决这个问题。 在这里,我向您推荐 Kutools for Excel 的选择特定单元格实用程序。 使用此实用程序,如果指定列的值大于或小于数字,您可以轻松选择特定范围内的所有行。 选择所有需要的行后,您可以手动将它们复制并粘贴到新工作表中。 见下图。

您可以通过以下超链接了解有关此功能的更多信息。
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
查看附件 (1 / 5)
该评论由网站上的主持人最小化
感谢这个公式,但我遇到了一个问题,当我想将行移动到另一张纸上时,它不会自动发生。 你能给我另一个公式吗? 因此,每当我更改单元格的值时,它都会自动移动。


谢谢
该评论由网站上的主持人最小化
亲爱的贾南,
在您手动触发运行按钮之前,代码不会自动发生。
该评论由网站上的主持人最小化
嗨,

我想设置这个宏,但有 2 个参数。 我设法根据 O 列中单元格的值使宏在我的文件中工作。但是我希望宏在移动行之前检查 S 列是否也已填写(或 <>“”) . 最后,我还希望复制的行与第二张表中的行具有相同的格式。 这会完全改变宏吗?
该评论由网站上的主持人最小化
亲爱的雨果,
我不知道我是否以正确的方式理解你。 你的意思是如果S列中的单元格被填写并且O列中的单元格同时包含某个值,那么移动带有格式的行? 不然不动?
该评论由网站上的主持人最小化
你好水晶,

是的,这正是我的意思。 事实上,我的数据是关于项目的。 我的 O 列是我的项目的状态,S 是我的项目的结束日期。
我希望我的用户,即拥有信息并需要插入信息的人,只有在他们的状态为“已关闭”并且已插入“结束日期”时才能“归档”项目。


我希望这有助于澄清事情
该评论由网站上的主持人最小化
亲爱的雨果,
抱歉这么晚才回复。 以下 VBA 代码可以帮助您解决问题。 请按照本文中的步骤应用 VBA 脚本。

子 MoveRowBasedOnCellValue()
将 xRgStatus 调暗为范围
将 xRgDate 调暗为范围
暗淡我只要
昏暗J只要
暗K只要
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
如果 J = 1 那么
如果 Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 那么 J = 0
结束如果
设置 xRgStatus = Worksheets("Sheet1").Range("O1:O" & I)
设置 xRgDate = Worksheets("Sheet1").Range("S1:S" & I)
出错时继续下一步
Application.ScreenUpdating = False
Application.CutCopyMode = False
xRgStatus(1).EntireRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
对于 K = 2 到 xRgStatus.Count
如果 CStr(xRgStatus(K).Value) = "已关闭" 那么
If (xRgDate(K).Value <> "") And (TypeName(xRgDate(K).Value) = "Date") 那么
xRgStatus(K).EntireRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
结束如果
结束如果
下一个
Application.CutCopyMode = True
Application.ScreenUpdating =真
END SUB
该评论由网站上的主持人最小化
亲爱的水晶,

非常感谢你的帮助!

问候,

雨果
该评论由网站上的主持人最小化
你好,


如何复制行而不是移动它们?
该评论由网站上的主持人最小化
你好,


我知道这已经发布了几次,但我找不到答案。 如何将材料复制到新工作表而不是从原始工作表中删除?
该评论由网站上的主持人最小化
亲爱的迈克:
如果您想复制行而不是删除它们,下面的 VBA 代码可以帮助您。 感谢您的评论!

子奶酪()
将 xRg 调暗为范围
将 xCell 调暗为范围
暗淡我只要
昏暗J只要
暗K只要
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
如果 J = 1 那么
如果 Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 那么 J = 0
结束如果
设置 xRg = Worksheets("Sheet1").Range("C1:C" & I)
出错时继续下一步
Application.ScreenUpdating = False
对于 K = 1 到 xRg.Count
如果 CStr(xRg(K).Value) = "Done" 那么
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
结束如果
下一个
Application.ScreenUpdating =真
END SUB
该评论由网站上的主持人最小化
嗨,

我是使用宏的新手,是否可以在某个值之后粘贴下面的数据并重复直到列结束?
喜欢此页 :

在“颜色”之后转移“蓝色”

A1 = 蓝色
A5= 颜色
A6=(在此处转移“蓝色”)
等等...
该评论由网站上的主持人最小化
亲爱的约翰,
你的意思是如果一个单元格在一列中包含“颜色”,那么将第一个单元格的文本复制到“颜色”下面的单元格并重复复制这个文本直到列的末尾?
这里还没有评论
了解更多

关注我们

版权所有 © 2009 - extendoffice.com。 | 版权所有。 供电 ExtendOffice。 | 网站地图
Microsoft和Office徽标是Microsoft Corporation在美国和/或其他国家的商标或注册商标。
受Sectigo SSL保护