将过滤后的数据从一个工作表复制到另一个工作表

Posted 2023-04-19

【中文标题】将过滤后的数据从一个工作表复制到另一个工作表

【英文标题】：Copying Filtered Data From One Sheet to Another

【发布时间】：2016-10-26 21:50:25

【问题描述】：

我正在尝试将过滤后的数据从一张纸复制到另一张纸。它将所有内容复制到同一行。

如何填充所有行而不是将它们复制到同一行上？

这是我修改的代码：

Private Sub Workbook_Open()
    Dim i, LastRow

    LastRow = Sheets("Scheduled WO's").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Branden").Range("A2:Q10000").ClearContents

    For i = 2 To LastRow
        If Sheets("Scheduled WO's").Cells(i, "G").Value = "Branden" Then
            Sheets("Scheduled WO's").Cells(i, "G").EntireRow.Copy Destination:=Sheets("Branden").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next
End Sub

【参考方案1】：

你必须取消声明

Sheets("Branden").Range("A2:Q10000").ClearContents

在每次打开它所在的工作簿时清除“Branden”工作表单元格

此外，由于您需要过滤，您可能希望使用Autofilter 并避免循环遍历单元格

Private Sub Workbook_Open()
    With Worksheets("Scheduled WO's")
        With .Range("G1:G" & .Cells(.Rows.Count, 1).End(xlUp).Row)
            .AutoFilter field:=1, Criteria1:="Branden"
            If Application.WorksheetFunction.Subtotal(103, .Cells) - 1 > 0 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(XlCellType.xlCellTypeVisible).EntireRow.Copy Worksheets("Branden").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End With
        .AutoFilterMode = False
    End With
End Sub

【讨论】：

我认为清除那张纸是故意的，这也与他的问题无关。

@Tyeler，对我来说，clearing 是 OP 问题的唯一可能原因。删除它，他的代码运行良好：Rows.Count 问题无效，因为所有范围引用，隐含地，相同的Workbook 所以Rows.Count 不是问题

它只在工作簿打开时运行该清除行一次。他说循环将第一张纸上的每一行复制到第二张纸的同一行上，最终在他的第二张纸上只留下一个（最后匹配的行）。我能看到这种情况发生的唯一方法是因为他引用了一个Rows.Count 来抵消，除了Rows.Count 永远不会改变，所以偏移量永远不会改变。我错了吗？

那 Rows.Count 后面总是跟着一个 End(xlUp) 以便最终的偏移量不断地跟踪列中最后一个非空单元格。至于其余部分：它是一个 Workbook_Open() 事件处理程序，因此所有代码（不仅是单元格清除）仅在工作簿打开时执行一次，并且仅在下一个工作簿打开时再次执行。无论如何我们必须等待OP cmets

我们每天都在接受教育。至于你的答案，完全取决于你。由于您指出了有用的问题，您可以对其进行编辑以删除实际上并不能解决 OP 问题的部分，并将其余部分作为良好的编码实践建议。尽管这可能会使您对任何过于“高效”的 SO 用户（不是我）的反对意见暴露出你的答案......

【参考方案2】：

根据匹配标准将行从一张纸复制到另一张纸

---

我们有两种方法可以解决这个问题。

代码 1

首先是坚持你正在做的事情，这可能是也可能不是完成此任务的较慢方式（取决于你要通过多少个单元格。）

Option Explicit

Private Sub Workbook_Open()
    Dim wsWO As Worksheet: Set wsWO = ThisWorkbook.Sheets("Scheduled WO's")
    Dim wsB As Worksheet: Set wsB = ThisWorkbook.Sheets("Branden")
    Dim LastRow As Long: LastRow = wsWO.Cells(wsWO.Rows.Count, 1).End(xlUp).Row
    Dim i As Long

    wsB.Range("A2:Q10000").ClearContents

    For i = 2 To LastRow
        If wsWO.Cells(i, "G").Value = "Branden" Then _
            wsWO.Cells(i, "G").EntireRow.Copy _
            wsB.Range("A" & wsB.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1)
    Next i
End Sub

代码 2

我们可以做到这一点的另一种方法是专门查找“Branden”的出现，然后复制这些行。

Option Explicit

Private Sub Workbook_Open()
    Dim wsWO As Worksheet: Set wsWO = ThisWorkbook.Sheets("Scheduled WO's")
    Dim wsB As Worksheet: Set wsB = ThisWorkbook.Sheets("Branden")
    Dim findBranden As Range: Set findBranden = wsWO.Range("G:G") _
        .Find(What:="Branden", LookIn:=xlValues, LookAt:=xlWhole)
    Dim firstResult As String

    wsB.Range("A2:Q10000").ClearContents

    If Not findBranden Is Nothing Then
        firstResult = findBranden.Address
        Do
            findBranden.EntireRow.Copy _
            wsB.Range("A" & wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row + 1)
            Set findBranden = wsWO.Range("G:G").FindNext(findBranden)
        Loop While Not findBranden Is Nothing And findBranden.Address <> firstResult
    Else: MsgBox "Nothing to move today.", vbInformation, ""
    End If
End Sub

---

您会注意到两个代码中都有一些新内容。

重要的是Option Explicit。如果您有任何未声明的变量，在您的代码模块顶部包含它会在编译时提醒您。这非常有用，因为它会在您的代码运行之前捕获拼写错误等。我敢说所有有经验的 VBA 编码人员都使用 Option Explicit 或在工具 > 选项 > 编辑器菜单中打开 Require Variable Declaration。

另一个非常重要的变化是声明我们正在使用的变量的特定类型。在您的代码中，LastRow 和 i 被假定为 Variant 类型，因为您从未指定它们的用途。最好在编码时尽可能具体，尤其是变量声明，因为这将使您的代码故障排除变得更加简单。

我还将您的工作表声明为变量，以使编写的代码更小，更易于阅读。

---

您可能会发现有用的文献

Why Option Explicit?

Why Require Variable Declaration?

Why declare the specific type of variable?

---

这两种方法都可行且易于操作。如果我能提供帮助，请告诉我:)