我有以下代码,非常适合复制数据。我对其进行了修改,以在应对之前过滤每个工作簿“名称”选项卡上的数据,但它不进行过滤,它仍会复制整个数据集。
所以我想要的是将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