VBA Excel筛选数据并复制到其他工作表-新手警报

嗨，我是一个完全的新手当谈到VBA Excel

我正在尝试过滤一个可变大小的电子表格，其中充满数据，在一列中查找一个集合词。找到后，我想将完整的行复制到另一个工作表中

因为他们可能不止一行有这个词，所以我不想写上一行

这是我创建来查找单词的，但是如何将行复制到另一个工作表中

Sheets("Sheet1").Select                                 'Select datasheet
Range("A1").Select                                      'Set cell position to start search from

Do Until Selection.Offset(0, 4).Value = ""              'word to be searched is 4 cell in
                                                        'do what is required
    If Selection.Offset(0, 4).Value = "UKS" Then
        MsgBox "Found"                                  'Found it!
        'not sure how to copy row to another worksheet
    End If

'finish move on to next one in list
         Selection.Offset(1, 0).Select                  'move down 1 row
    Loop

    Range("A1").Select ' reset cell position

任何帮助将不胜感激，请你解释一下它是如何工作的，以及我想了解的，而不仅仅是复制

---

Jason

这里是一个循环代码示例和一个过滤器代码示例

Sub loopMe()

    Dim sh As Worksheet, ws As Worksheet
    Dim LstR As Long, rng As Range, c As Range

    Set sh = Sheets("Sheet1")    'set the sheet to loop
    Set ws = Sheets("Sheet2")    'set the sheet to paste
    With sh    'do something with the sheet
        LstR = .Cells(.Rows.Count, "D").End(xlUp).Row    'find last row
        Set rng = .Range("D2:D" & LstR)    'set range to loop
    End With

    'start the loop
    For Each c In rng.Cells
        If c = "UKS" Then
            c.EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)    'copy row to first empty row in sheet2
        End If
    Next c

End Sub

Sub FilterMe()
    Dim sh As Worksheet, ws As Worksheet
    Dim LstR As Long, rng As Range

    Set sh = Sheets("Sheet1")    'set the sheet to filter
    Set ws = Sheets("Sheet2")    'set the sheet to paste
    Application.ScreenUpdating = False
    With sh    'do something with the sheet
        LstR = .Cells(.Rows.Count, "D").End(xlUp).Row    'find last row
        .Columns("D:D").AutoFilter Field:=1, Criteria1:="UKS"
        Set rng = .Range("A2:Z" & LstR).SpecialCells(xlCellTypeVisible)    'Replace Z with correct last column
        rng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
        .AutoFilterMode = False
    End With

End Sub

---

看看下面，也许它能给你线索。 不过，我会尽量对细节进行评论，以便让您对此事有更深入的了解

我的例子有点复杂，因为它一次对两列应用过滤，但它有助于您理解它的复杂性，因为您可以进一步应用它

 With Sheets("Source")
            .AutoFilterMode = False
        With .Range("$A$21" & ":" & "$C$" & 300)
             .AutoFilter Field:=1, Criteria1:=Array("April", "August", "Dezember", "Februar", "Januar", "Juli", "Juni", "Mai", "März", "November", "Oktober", "September"), Operator:=xlFilterValues
             .AutoFilter Field:=2, Criteria1:="<>"
             ActiveSheet.AutoFilter.Range.Copy
             Sheets("Chart").Select
             Range("A7").Select
            Sheets("Chart").Paste
         End With
        End With

带工作表（“源”）
.AutoFilterMode=False
带.Range（“$A$21”&”：“&$C$”&300）
.AutoFilter字段：=1，准则1：=Array（“四月”、“八月”、“十二月”、“二月”、“一月”、“朱利”、“朱尼”、“Mai”、“马尔兹”、“十一月”、“奥克托伯”、“九月”），运算符：=xlFilterValues
.自动筛选字段：=2，标准1:=“”
ActiveSheet.AutoFilter.Range.Copy
表格（“图表”）。选择
范围（“A7”）。选择
表格（“图表”）。粘贴
以
以

那么，这是关于什么的：

代码的逻辑是

• 在两列中筛选第1列按月份名称（即德语）筛选，第2列通过删除空白/空单元格筛选元素

附页（“来源”） .AutoFilterMode=False 带.Range（“$A$21”&”：“&$C$”&300） .AutoFilter字段：=1，准则1：=Array（“四月”、“八月”、“十二月”、“二月”、“一月”、“朱利”、“朱尼”、“Mai”、“马尔兹”、“十一月”、“奥克托伯”、“九月”），运算符：=xlFilterValues

• 包含要应用筛选的表的工作表的名称为“源”。将自动筛选设置为false
  .AutoFilterMode=False

• 过滤值设置如下： 第1栏

.AutoFilter字段：=1，准则1：=Array（“四月”、“八月”、“十二月”、“二月”、“一月”、“朱利”、“朱尼”、“Mai”、“马尔兹”、“十一月”、“奥克托伯”、“九月”），运算符：=xlFilterValues

第2栏

.自动筛选字段：=2，标准1:=“”

• 最后，但并非最不重要（非常重要）的是范围（应用筛选的表的单元格）

带.Range（“$A$21”&”：“&$C$”&300）

在本例中，我的示例将过滤器应用于从A21开始到C300结束的单元格范围（事实上是一个表）

为什么是A21？因为我的数据就是在这里被复制的。它总是从21开始

为什么是C300？因为最大行数永远不会超过（300-21）=279行 我的数据模型在任何时候都不会超过279个未过滤行，您可以根据您的假设输入更大的数字。 如果有更多的行，不用担心，因为我通过删除空格来过滤它们，请参见上文

顺便说一句，“犹太”版本是通过VBA计算行数，并在定义范围时使用它

您可以简单地使用一个非常大的数字来覆盖表中可能的行数

计算行数乍看起来可能有点复杂，但最终还是要付出代价的

假设您想计算B列中的行数（变量） FinalRowChartSheet=范围（“B7”）。结束（xlDown）。行

祝你一切顺利。我希望我帮助了你

---

如果你觉得我的答案有用，别忘了给它打分。谢谢。

谢谢，这很有帮助。