如何在自动筛选并使用后使用VBA粘贴为值.结束

Question

我正在使用以下代码自动筛选一张工作表上的数据，并将特定列粘贴到另一张工作单上。我遇到的问题是，wsData工作表中AG和AJ列中的数据是公式，但我需要将其粘贴为值。我该如何修改此代码？

With wsData.Rows(1)
.AutoFilter field:=30, Criteria1:="In Progress - On Order"
If wsData.Range("AC1:C" & lastrow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("N2:N" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2)
wsData.Range("C2:C" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("B" & Rows.Count).End(3)(2)
wsData.Range("Q2:Q" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("F" & Rows.Count).End(3)(2)
wsData.Range("R2:R" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("G" & Rows.Count).End(3)(2)
wsData.Range("S2:S" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("H" & Rows.Count).End(3)(2)
wsData.Range("T2:T" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("I" & Rows.Count).End(3)(2)
wsData.Range("AG2:AG" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("C" & Rows.Count).End(3)(2)
wsData.Range("AJ2:AJ" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("M" & Rows.Count).End(3)(2)


wsDest.UsedRange.Borders.ColorIndex = xlNone
wsDest.Select
End If
.AutoFilter field:=30

以结束

非常感谢，

Answer 1

请替换：

wsData.Range("AG2:AG" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("C" & Rows.Count).End(3)(2)
wsData.Range("AJ2:AJ" & lastrow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("M" & Rows.Count).End(3)(2)

带有：

wsData.Range("AG2:AG" & lastrow).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("C" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
wsData.Range("AJ2:AJ" & lastrow).SpecialCells(xlCellTypeVisible).Copy 
wsDest.Range("M" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues

如果不需要格式，你可以通过不涉及剪贴板(使用数组，但使用函数将不连续的范围转换为连续的范围…(来使代码更快，消耗更少的资源

事实上，请尝试下一个改编的代码：

Sub ArrayVariant()
'your existing code
Dim arr
If wsData.Range("AC1:C" & lastRow).SpecialCells(xlCellTypeVisible).cells.count > 1 Then
arr = contArrayFromDscRng(wsData.Range("N2:N" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("A" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr
arr = contArrayFromDscRng(wsData.Range("C2:C" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("B" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr
arr = contArrayFromDscRng(wsData.Range("Q2:Q" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("F" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr
arr = contArrayFromDscRng(wsData.Range("R2:R" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("G" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr
arr = contArrayFromDscRng(wsData.Range("S2:S" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("H" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr
arr = contArrayFromDscRng(wsData.Range("T2:T" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("I" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr
arr = contArrayFromDscRng(wsData.Range("AG2:AG" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("C" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr
arr = contArrayFromDscRng(wsData.Range("AJ2:AJ" & lastRow).SpecialCells(xlCellTypeVisible))
wsDest.Range("M" & rows.count).End(3)(2).Resize(UBound(arr), UBound(arr, 2)).value = arr

wsDest.UsedRange.Borders.ColorIndex = xlNone
wsDest.Activate
End If
'your existing code...
End Sub
Function contArrayFromDscRng(rng As Range) As Variant 'makes an array from a discontinuous range
Dim A As Range, arr, count As Long, i As Long

ReDim arr(1 To rng.cells.count, 1 To 1): count = 1
For Each A In rng.Areas
For i = 1 To A.cells.count
arr(count, 1) = A.cells(i).value: count = count + 1
Next
Next
contArrayFromDscRng = arr
End Function