Question

我有一个包含所有原始数据的主工作簿。其中的B列为空或包含文本“是”。

我有另一个工作簿，必须包含B列中包含“是”的主工作簿的所有行。

每次宏运行时，我都需要清空第二个过滤的工作簿并检查第1行的主工作簿。

如何使用VBA实现这一目标？

编辑1 ：这是我一直在处理的代码

Sub filter()

Dim LastRow As Integer, i As Integer, erow As Integer

LastRow = ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If Cells(i, 1) = Date And Cells(i, 2) = “Yes” Then
Range(Cells(i, 1), Cells(i, 7)).Select
Selection.Copy

Workbooks.Open Filename:="C:\Users\212557423\Desktop\2.xls"
Worksheets(“Sheet1”).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If

Next i
End Sub

Edit2 ：经过一些研究后，我有以下代码：

Sub filter()
Dim strsearch As String, lastline As Integer, tocopy As Integer

lastline = Range("A65536").End(xlUp).Row
j = 1

For i = 1 To lastline
    For Each c In Range("B" & i)
        If InStr(c.Text, "ja") Then
            Rows(i).Copy Destination:=Sheets(2).Rows(j)
        j = j + 1
        End If
    Next c
Next i

End Sub

我现在的问题是这个宏只能从一张纸复制到另一张。我需要的是“slave”工作簿从“master”工作簿中获取行。

有人可以帮忙吗？谢谢！

Answer 1

编辑：只是添加警告，根据您的要求，在从原始数据工作表添加当前过滤值之前，过滤后的工作簿始终已清空

试试这个

Option Explicit

Sub main()
    Dim rawDataSht As Worksheet, filtDataSht As Worksheet

    Set rawDataSht = ActiveSheet
    Workbooks.Open Filename:="C:\Users\212557423\Desktop\2.xls"
    Set filtDataSht = ActiveWorkbook.Worksheets("Sheet1")

    With rawDataSht
        With .Range("A1:G" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .AutoFilter field:=2, Criteria1:="YES"
            If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then
                filtDataSht.Cells.Clear
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeConstants).Copy
                filtDataSht.Cells(1, 1).PasteSpecial xlPasteAll
                Application.CutCopyMode = False
            Else
                MsgBox "No data with ""YES"" in column B of sheet " & .Parent.name & " of workbook " & .Parent.Parent.name
            End If
            .AutoFilter
        End With
    End With
    ActiveWorkbook.Close (True)    
End Sub

Answer 2

这是完成任务的略有不同的方式。

    With ActiveSheet
        .AutoFilterMode = False
        With Range("B1", Range("B" & Rows.Count).End(xlUp))
            .AutoFilter Field:=1, Criteria1:=Array("YES"), Operator:=xlFilterValues
            On Error Resume Next
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        End With
    Workbooks("C:\Users\212557423\Desktop\2.xls").Sheets("Sheet1").Cells(1, 1).PasteSpecial xlPasteValues
        .AutoFilterMode = False
    Application.CutCopyMode = False
    End With

VBA如何将条件从Workbook复制到另一个条件

2 个答案: