使用输入值自动过滤列,然后将过滤后的数据复制到另一个工作簿

时间:2020-11-06 21:37:35

标签: excel vba

我有以下代码,非常适合复制数据。我对其进行了修改,以在应对之前过滤每个工作簿“名称”选项卡上的数据,但它不进行过滤,它仍会复制整个数据集。

所以我想要的是将L列(字段= 12)过滤为大于输入条件的值;然后从工作簿中复制这些值。

我想保留这段代码,但是调整粗体区域来做到这一点。请告诉我我做错了什么;谢谢。

代码是

Dim sNames As Variant
sNames = Array("Jewel.xlsm", "Tamar.xlsm", "Britty.xlsm")

Dim wb As Workbook
Set wb = ActiveWorkbook

With wb.Worksheets("Data")
 Dim dFirst As Range
Set dFirst = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With

Dim dCell As Range
Set dCell = dFirst

Dim sName As Variant
Dim sLastRow As Long
Dim sRng As Range
Dim dRows As Long

For Each sName In sNames
With Workbooks(sName).Worksheets("Names")
sLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set sRng = .Range("A2:N" & sLastRow)
End With

  **With sRng
  Dim i As String
  i = InputBox("Last Actual 'RED' Date")
  
  Selection.AutoFilter
 .Range("A2:N" & sLastRow).AutoFilter field:=12, Criteria1:=">" & i
  End With**

    With sRng
     dCell.Resize(.Rows.Count, .Columns.Count).Value = sRng.Value
     dRows = dRows + .Rows.Count
     Set dCell = dCell.Offset(.Rows.Count)
End With
Next sName
With dFirst.Resize(dRows, sRng.Columns.Count)
.Interior.Color = xlNone
With .Font
  .Name = "Calibri"
   .Size = 10
    End With
End With

End Sub

0 个答案:

没有答案