копировать данные с листа на лист по нескольким критериям

Question

Я хочу скопировать данные с листа 2 на лист 5 по нескольким критериям. пример данных:

Я написал следующий код ...

Dim myrange As Range

Set myrange = Worksheets("Sheet2").Range("a1:k50")

myrange.Parent.AutoFilterMode = False

myrange.AutoFilter field:=1, criteria1:="=Monitors"
myrange.AutoFilter field:=2, criteria1:="=Jul-19"
myrange.AutoFilter field:=3, criteria1:="=1"
myrange.AutoFilter field:=5, criteria1:="=P"

myrange.Parent.AutoFilter.Range.Copy

With Sheet5.Range("a10")
.PasteSpecial Paste:=8
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            .Select
End With
myrange.Parent.AutoFilterMode = False

Когда я запускаю код, он копирует только заголовки.

вывод должен быть.

Есть мысли?

Answer 1

Я бы сделал немного по-другому, так как я не слишком люблю использовать фильтры в макросах. Обратите внимание, что этот код будет вставлен в последнюю строку Sheet5Не стесняйтесь адаптировать его к вашим потребностям. Также обратите внимание, что использование дат (например, «Jul-19») в этом формате может вызвать некоторые проблемы. Попробуйте преобразовать его (в приведенном ниже коде) в значение в зависимости от формата исходной таблицы:

Sub testStackOverflow()
Dim myrange As Range
Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Dim Criteria4 As String

Set myrange = Worksheets("Sheet2").Range("A1:A50")


Criteria1 = "Monitors"
Criteria2 = "Jul-19"
Criteria3 = "1"
Criteria4 = "P"



For Each SearchCell In myrange
    Debug.Print SearchCell.Value
    If SearchCell.Value = Criteria1 Then
        If SearchCell.Offset(0, 1).Value = Criteria2 Then
            If SearchCell.Offset(0, 2).Value = Criteria3 Then
                If SearchCell.Offset(0, 4).Value = Criteria4 Then
                    LastRow = Sheets("Sheet5").Range("A1048576").End(xlUp).Row + 1
                    Sheets("Sheet5").Range("A" & LastRow).Value = SearchCell.Value
                    Sheets("Sheet5").Range("B" & LastRow).Value = SearchCell.Offset(0, 1).Value
                    Sheets("Sheet5").Range("C" & LastRow).Value = SearchCell.Offset(0, 2).Value
                    Sheets("Sheet5").Range("D" & LastRow).Value = SearchCell.Offset(0, 3).Value
                    Sheets("Sheet5").Range("E" & LastRow).Value = SearchCell.Offset(0, 4).Value
                End If
            End If
        End If
    End If
Next SearchCell

End Sub