跳至主要内容

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

Author: Xiaoyang Last Modified: 2025-07-31

假设你有一个包含三个工作表的工作簿,这些工作表的格式相同,如下图所示。现在,你想将这些工作表中列C包含文本“已完成”的所有行复制到一个新的工作表中。如何快速轻松地解决这个问题,而无需手动逐个复制和粘贴呢?

sample data 1 ample data 2 ample data 3

使用VBA代码根据条件从多个工作表中复制行到新工作表


使用VBA代码根据条件从多个工作表中复制行到新工作表

以下VBA代码可以帮助你根据特定条件从工作簿中的所有工作表复制特定行到新的工作表。请按照以下步骤操作:

1. 按住ALT + F11键打开Microsoft Visual Basic for Applications窗口。

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 = "Completed"脚本中的文本“已完成”表示要基于其复制行的特定条件;
  • Set xRg = xWs.Range("C:C")脚本中的C:C表示条件所在的特定列。

3. 然后,按F5键运行此代码,所有符合特定条件的行都已复制并粘贴到当前工作簿中名为Kutools for Excel的新工作表中。请参见截图:

vba code to copy rows from multiple worksheets based on criteria



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

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

  • 超级公式栏(轻松编辑多行文本和公式);阅读布局(轻松读取和编辑大量单元格);粘贴到筛选区域...
  • 合并单元格/行/列并保留数据;拆分单元格内容;合并重复行并求和/平均值... 防止重复单元格;比较区域...
  • 选择重复或唯一行选择空白行(所有单元格为空);在多个工作簿中进行超级查找和模糊查找;随机选择...
  • 精准复制多个单元格而不改变公式引用;自动创建对多个工作表的引用;插入项目符号、复选框等...
  • 收藏并快速插入公式、区域、图表和图片;用密码加密单元格创建邮件列表并发送电子邮件...
  • 提取文本,添加文本,按位置删除,删除空格;创建并打印分页小计;在单元格内容和批注之间转换...
  • 超级筛选(保存并应用筛选方案到其他工作表);按月/周/日高级排序,频率等;按粗体、斜体特殊筛选...
  • 合并工作簿和工作表;基于关键列汇总表格;将数据分割到多个工作表批量转换 xls、xlsx 和 PDF...
  • 数据透视表按周数、星期几等分组... 用不同颜色显示未锁定、已锁定单元格高亮显示包含公式的单元格/名称...
kte tab 201905
  • 在 Word、Excel、PowerPoint、Publisher、Access、Visio 和 Project 中启用标签式编辑和阅读。
  • 在同一窗口的新标签页中打开和创建多个文档,而不是在新窗口中。
  • 将您的生产力提高 50%,每天为您减少数百次鼠标点击!
officetab bottom