VBAdynamic过滤和复制粘贴到新的工作表

我想写一个VBA脚本，将过滤两列，列A和列D.最好，我想创build一个button，将执行一次，我已经select了过滤条件。 下面的input数据示例。

Sub Compiler() Dim i Dim LastRow As Integer LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row Sheets("Sheet4").Range("A2:J6768").ClearContents For i = 2 To LastRow If Sheets("Sheet1").Cells(i, "A").Values = Sheets("Sheet3").Cells(3, "B").Values And Sheets("Sheet1").Cells(i, "D").Values = Sheets("Sheet3").Cells(3, "D").Values Then Sheets("Sheet1").Cells(i, "A" & "D").EntireRow.Copy Destination:=Sheets("Sheet4").Range("A" + Rows.Count).End(xlUp) End If Next i End Sub 

示例数据来运行vba脚本

Answer 1

我已经把我以前的答案的变化包括在下面提供的完整代码块中。

 Sub Compiler() Dim i Dim LastRow, Pasterow As Integer Dim sht As Worksheet Set sht = ThisWorkbook.Sheets("Sheet4") LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row Sheets("Sheet4").Range("A2:J6768").ClearContents For i = 2 To LastRow If Sheets("Sheet1").Range("A" & i).Value = Sheets("Sheet3").Range("B3").Value And Sheets("Sheet1").Range("D" & i).Value = Sheets("Sheet3").Range("D3").Value Then Pasterow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1 Sheets("Sheet1").Rows(i).EntireRow.Copy Destination:=Sheets("Sheet4").Range("A" & Pasterow) End If Next i Sheets("sheet4").Rows(1).Delete End Sub 

Answer 2

 Sheets("Sheet1").Cells(i, "A").Values Sheets("Sheet3").Cells(3, "B").Values 

等等

你继续使用values 。 你不是说value吗？

Answer 3

这回答了我所问的问题，我试图与丹的答案一起工作，但并没有走得很远。

 Private Sub CommandButton1_Click() FinalRow = Sheets("Sheet1").Cells(rows.Count, 1).End(xlUp).Row Sheets("Sheet4").Range(Sheets("Sheet4").Cells(1, "A"), Sheets("Sheet4").Cells(FinalRow, "K")).ClearContents If Sheets("Sheet4").Cells(1, "A").Value = "" Then Sheets("Sheet1").Range("A1:K1").Copy Sheets("Sheet4").Range(Sheets("Sheet4").Cells(1, "A"), Sheets("Sheet4").Cells(1, "K")).PasteSpecial (xlPasteValues) End If For x = 2 To FinalRow ThisValue = Sheets("Sheet1").Cells(x, "A").Value ThatValue = Sheets("Sheet1").Cells(x, "D").Value If ThisValue = Sheets("Sheet3").Cells(3, "B").Value And ThatValue = Sheets("Sheet3").Cells(3, "D").Value Then Sheets("Sheet1").Range(Sheets("Sheet1").Cells(x, 1), Sheets("Sheet1").Cells(x, 11)).Copy Sheets("Sheet4").Select NextRow = Sheets("Sheet4").Cells(rows.Count, 1).End(xlUp).Row + 1 With Sheets("Sheet4").Range(Sheets("Sheet4").Cells(NextRow, 1), Sheets("Sheet4").Cells(NextRow, 11)) .PasteSpecial (xlPasteFormats) .PasteSpecial (xlPasteValues) End With End If Next x Worksheets("Sheet4").Cells.EntireColumn.AutoFit End Sub