![](/img/trans.png)
[英]How to copy filtered range and then to paste that filtered range itno another filtered range in the same sheet using vba
[英]Paste filtered results to another sheet
我正在構建具有三個過程工作表(FTP,ATP,CS)和失敗報告工作表的模板。 我想做的是對每個過程表應用高級過濾器,僅復制過濾后的結果,並將它們連續粘貼到“故障報告”中的指定范圍內。
我的高級過濾器可以正常工作,但是當我嘗試將結果復制到失敗報告中時,它會導致問題。 FTP結果將正確粘貼,但是ATP和CS將粘貼到指定范圍的底部(並擴大范圍)。 我需要告訴它粘貼到列A中的下一個空單元格中(在指定的范圍內)。 我已附上返回結果的副本。
Sub AdvancedFilterCopyAttempt()
' Script to apply an advanced filter to multiple worksheets and copy those results to copy to the Failure Report.
'Declare Variables
Dim rngCopy As Range, rngCopyNotes As Range
Dim NextRow As Long
Dim wsFTP As Worksheet, wsATP As Worksheet, wsFail As Worksheet, wsCS As Worksheet
Set wsFTP = Sheets("Results")
Set wsATP = Sheets("ATP Results")
Set wsFail = Sheets("Failure Report")
Set wsCS = Sheets("CS Results")
Sheets("Results").Activate
Range("Results").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("Criteria"), Unique:=False
Sheets("ATP Results").Activate
Range("A:I").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("APTCriteria"), Unique:=True
Sheets("CS Results").Activate
Range("A:I").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("CSCriteria"), Unique:=True
wsFTP.Activate
'copy FTP results to Failure Report
Set rngCopy = wsFTP.Range("Results_Part1").SpecialCells(xlCellTypeVisible)
Set rngCopyNotes = wsFTP.Range("Results_Part2").SpecialCells(xlCellTypeVisible)
Sheets("Failure Report").Range("A:A").ClearContents
NextRow = wsFail.Range("Fail_Report_Table").Cells(1, 1).Row
rngCopy.Copy wsFail.Range("A" & NextRow)
rngCopyNotes.Copy wsFail.Range("H" & NextRow)
wsATP.Activate
'copy ATP results to Failure Report
Set rngCopy = wsATP.Range("APTResults1").SpecialCells(xlCellTypeVisible)
Set rngCopyNotes = wsATP.Range("APTResults2").SpecialCells(xlCellTypeVisible)
NextRow = wsFail.Range("Fail_Report_Table").Cells(1, 1).End(xlDown).Offset(1).Row
rngCopy.Copy wsFail.Range("A" & NextRow)
rngCopyNotes.Copy wsFail.Range("H" & NextRow)
wsCS.Activate
Set rngCopy = wsCS.Range("CSResults1").SpecialCells(xlCellTypeVisible)
Set rngCopyNotes = wsCS.Range("CSResults2").SpecialCells(xlCellTypeVisible)
NextRow = wsFail.Range("Fail_Report_Table").Cells(1, 1).End(xlDown).Offset(1).Row
rngCopy.Copy wsFail.Range("A" & NextRow)
rngCopyNotes.Copy wsFail.Range("H" & NextRow)
Sheets("Failure Report").Activate
End Sub
好的,現在我知道Fail_Report_Table
從A22開始,請更改行
NextRow = wsFail.Range("Fail_Report_Table").Cells(1, 1).End(xlDown).Offset(1).Row
至
NextRow = wsFail.Range("Fail_Report_Table").Cells(1, 1).Offset(-1).End(xlDown).Offset(1).Row
兩次都發生。
注意:我知道您已經為此做了很多工作,因此它確實可以為您研究為什么進行這些更改,而不僅僅是將它們復制到您的代碼中並繼續前進,因此您真正了解了它的作用,因此您將來可以復制它,也可以根據需要對其進行操作。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.