跳到主要内容

如何根据条件将多个工作表中的行复制到新工作表中?

作者:晓阳 最后修改时间:2019-09-10

假设您有一个包含三个工作表的工作簿,这些工作表的格式与下面的屏幕快照相同。 现在,您想要将这些工作表中的C列包含“已完成”文本的所有行复制到新工作表中。 您如何快速,轻松地解决此问题,而又不手动一一复制和粘贴它们?

根据条件将多个工作表中的行复制到具有VBA代码的新工作表中


根据条件将多个工作表中的行复制到具有VBA代码的新工作表中

下面的VBA代码可以帮助您根据特定条件将工作簿中所有工作表中的特定行复制到新工作表中。 请这样做:

1。 按住 ALT + F11 键打开 Microsoft Visual Basic应用程序 窗口。

2。 点击 插页 > 模块,然后将以下代码粘贴到“模块窗口”中。

VBA代码:根据条件将多个工作表中的行复制到新工作表中

Public Sub CopyRows_ValuesAndNumberFormats()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Kutools for Excel"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1
For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then
        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)
        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If
        Next xRRg
    End If
Next xWs
Application.DisplayAlerts = True
End Sub

备注:在上面的代码中:

  • 文本 ”完成”在此 xRStr =“已完成” 脚本指示您要基于其复制行的特定条件;
  • C:C 摘要可点击此连结 设置xRg = xWs.Range(“ C:C”) 脚本指示条件所在的特定列。

3。 然后按 F5 键运行此代码,并且具有特定条件的所有行已被复制并粘贴到当前工作簿中名为 Kutools for Excel 的新工作表中。看截图:


更多相关的拉取或复制数据文章:

  • 使用Excel中的高级筛选器将数据复制到另一个工作表
  • 通常,我们可以快速应用“高级筛选器”功能从同一工作表中的原始数据中提取数据。 但是,有时,当您尝试将筛选的结果复制到另一个工作表时,会收到以下警告消息。 在这种情况下,您如何在Excel中处理此任务?
  • 根据Excel中的列条件将行复制到新表
  • 例如,有一个水果购买表,现在您需要根据指定的水果将记录复制到新表中,如何在Excel中轻松完成它? 在这里,我将介绍几种基于Excel中的列条件将行复制到新工作表的方法。
  • 如果列在Excel中包含特定的文本/值,则复制行
  • 假设您要找出一列中包含特定文本或值的单元格,然后复制找到的单元格所在的整行,您该如何处理? 在这里,我将介绍几种方法来查找列是否包含特定的文本或值,然后在Excel中复制整个行。

  • 超级公式栏 (轻松编辑多行文本和公式); 阅读视图 (轻松读取和编辑大量单元格); 粘贴到过滤范围...
  • 合并单元格/行/列 和保存数据; 拆分单元格内容; 合并重复的行和总和/平均值...防止细胞重复; 比较范围...
  • 选择重复或唯一 行; 选择空白行 (所有单元格都是空的); 超级查找和模糊查找 在许多工作簿中; 随机选择...
  • 确切的副本 多个单元格,无需更改公式参考; 自动创建参考 到多张纸; 插入项目符号,复选框等...
  • 收藏并快速插入公式,范围,图表和图片; 加密单元 带密码 创建邮件列表 并发送电子邮件...
  • 提取文字,添加文本,按位置删除, 删除空间; 创建和打印分页小计; 在单元格内容和注释之间转换...
  • 超级筛选 (将过滤方案保存并应用于其他工作表); 高级排序 按月/周/日,频率及更多; 特殊过滤器 用粗体,斜体...
  • 结合工作簿和工作表; 根据关键列合并表; 将数据分割成多个工作表; 批量转换xls,xlsx和PDF...
  • 数据透视表分组依据 周号,周几等 显示未锁定的单元格 用不同的颜色 突出显示具有公式/名称的单元格...
kte选项卡201905
  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,发布者,Access,Visio和Project。
  • 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
  • 每天将您的工作效率提高50%,并减少数百次鼠标单击!
officetab底部
Comments (2)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,

thank you very much for the code. I have a question: the code runs smoothly on some of my sheets, but looks like enters an infinite loop in some other ones which makes excel crash. What could the reason be?
This comment was minimized by the moderator on the site
Hello there, thank you so much for the code above, it solved me a problem with a complex file; a solution I have been looking for a while now. Thank you..I have one question. How do I change the code so that it copies the rows but only from colum A to colum Q, so not Entire.Row?Thank you in advance and great work!
There are no comments posted here yet
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations