将过滤的结果粘贴到列中的下一个空行上
我正在build立一个技术人员在生产车间使用的自定义模板。 我正试图做的是在单独的工作表（FTP结果和ATP结果）上过滤结果，将这些结果复制到另一个工作表中特定列中的下一个空单元（失败报告）。 我有FTP结果和ATP结果作为命名范围（分别为结果和APTResults）和故障报告（Fail_Report_Table）一样。 我需要将FTP结果/ ATP结果表的前两列粘贴到Fail_Report_Table（A22：B22）的前两列，然后粘贴到最后两列Fail_Report_Table（H22：I22）中。
至于我现在所拥有的东西，我只能从一张纸上拉下来，而不是两张都能正常工作。 我可以把它应用到两张纸上的高级filter，但它只会复制来自ATP结果的结果。 我需要先从FTP结果中粘贴过滤结果，然后在列A和H中find下一个可用的单元格，然后在此处粘贴来自ATP结果的过滤结果。 过滤值的数量会有所不同，所以解决scheme必须是dynamic的。 我对VBA比较陌生，而且我的代码有点混乱（我相当确信这是问题的一部分）。
Sub AdvancedFilter() ' 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 Dim rngCopyNotes As Range Dim rngCopyFailCT As Range Dim rngATPCopy As Range Dim rngATPCopyNotes As Range Dim rngATPCopyFailCT As Range Dim NextRow As Long Dim Sht As Worksheet 'Filter ATP and FTP Results on (FTP)Results and ATP Results worksheets based on true/false criteria. Sheets("Results").Select Range("Results").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("Criteria"), Unique:=True Sheets("ATP Results").Select Range("A1:I392").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("APTCriteria"), Unique:=False Sheets("Results").Activate 'Set Variables to copy the filtered FTP values to the Failure Report Set rngCopy = Sheets("Results").Range("Results_Part1").SpecialCells(xlCellTypeVisible) Set rngCopyNotes = Sheets("Results").Range("Results_Part2").SpecialCells(xlCellTypeVisible) 'Set destination on the Failure Report for Copied FTP Values rngCopy.Copy Destination:=Sheets("Failure Report").Range("A21") rngCopyNotes.Copy Destination:=Sheets("Failure Report").Range("H21") 'Copy headers from Results to Failure Report Sheets("Results").Activate Range("A1:B1").Select Selection.Copy Sheets("Failure Report").Select Range("A21:B21").PasteSpecial Sheets("Results").Activate Range("G1,H1").Select '("J2:I2") Selection.Copy Sheets("Failure Report").Select Range("H21:I21").PasteSpecial 'Copy format from original header cell from Failure Report to imported headers Range("D21").Select Selection.Copy Range("A21:B21").Select ' note that we select the whole merged cell Selection.PasteSpecial Paste:=xlPasteFormats Range("D21").Select Selection.Copy Range("H21:I21").Select ' note that we select the whole merged cell Selection.PasteSpecial Paste:=xlPasteFormats Range("F12").Select Sheets("Results").Activate Application.CutCopyMode = False Range("N34").Select Sheets("Failure Report").Activate 'Set Variables for source ATP Results. Set rngATPCopy = Sheets("ATP Results").Range("APTResults1").SpecialCells(xlCellTypeVisible) Set rngATPCopyNotes = Sheets("ATP Results").Range("APTResults2").SpecialCells(xlCellTypeVisible) Set Sht = ThisWorkbook.Worksheets("Failure Report") NextRow = Sht.Range("Fail_Report_Table").Rows.Count 'Set destination for Copied Values on Failure Report 'Must be set to paste under the last occupied row (copied previously from FTP) rngATPCopy.Copy Destination:=Sheets("Failure Report").Range("A21") rngATPCopyNotes.Copy Destination:=Sheets("Failure Report").Range("H21") Range("F12").Select Sheets("ATP Results").Activate Application.CutCopyMode = False Range("N34").Select End Sub 我想所有你需要做的是find每一组复制和粘贴你需要的下一个可用的行，然后使用该行作为放置数据的位置的variables。 看下面的代码（注意，你不需要使用Select ，但是可以直接使用对象本身）。
Sub AdvancedFilter() ' 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 Set wsFTP = Sheets("Results") Set wsATP = Sheets("ATP Results") Set wsFail = Sheets("Failure Report") 'Filter ATP and FTP Results on (FTP)Results and ATP Results worksheets based on true/false criteria. wsFTP.Range("Results").AdvancedFilter xlFilterInPlace, Range("Criteria"), , True wsATP.Range("A1:I392").AdvancedFilter xlFilterInPlace, Range("Criteria"), , True 'copy FTP results to Failure Report Set rngCopy = wsFTP.Range("Results_Part1").SpecialCells(xlCellTypeVisible) Set rngCopyNotes = wsFTP.Range("Results_Part2").SpecialCells(xlCellTypeVisible) NextRow = wsFail.Range("Fail_Report_Table").Cells(1,1).Row rngCopy.Copy wsFail.Range("A" & NextRow) rngCopyNotes.Copy wsFail.Range("H" & NextRow) 'Copy headers from Results to Failure Report '### - WHY DO YOU NEED TO COPY HEADERS EACH TIME???? Isn't once sufficient??? wsFail.Range("A" & NextRow & ":B" & NextRow).Value = wsFTP.Range("A1:B1").Value wsFail.Range("G" & NextRow & ":H" & NextRow).Value = wsFTP.Range("G1:H1").Value 'Copy format from original header cell from Failure Report to imported headers wsFTP.Range("D1").Copy wsFail.Range("A" & NextRow & ":B" & NextRow).PasteSpecial xlPasteFormats wsFail.Range("G" & NextRow & ":H" & NextRow).PasteSpecial xlPasteFormats 'copy ATP results to Failure Report Set rngCopy = wsATP.Range("ATPResults1").SpecialCells(xlCellTypeVisible) Set rngCopyNotes = wsATP.Range("ATPResults2").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) End Sub