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

时间:2016-10-26 21:50:25

标签: excel vba

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

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

以下是我修改的代码:

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

2 个答案:

答案 0 :(得分:0)

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

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

代码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或在工具&gt;中启用Require Variable Declaration。选项&gt;编辑菜单。

另一个非常重要的变化是声明我们正在使用的变量的特定类型。在您的代码中,LastRowi被假定为Variant类型,因为您从未指定过它们的用途。在编码时尽可能具体,特别是使用变量声明,这是一种很好的做法,因为它可以使代码的排除更加简单。

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

你可能认为有用的文学

Why Option Explicit?

Why Require Variable Declaration?

Why declare the specific type of variable?

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

答案 1 :(得分:0)

你必须取消声明

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

清除&#34; Branden&#34;工作表单元格位于其所在工作簿的每个开头

此外,由于您需要过滤,您可能需要使用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