将过滤后的结果粘贴到列中的下一个空行

I am building a custom template for technicians to use while on the production floor. What I am attempting to do is filter the results on separate sheets (FTP Results and ATP Results), copy those results to the next empty cell in a specific column in another sheet (Failure Report). I have both the FTP Results and ATP Results as named ranges (Results and APTResults respectively) as is the Failure Report (Fail_Report_Table). I need to paste the first two columns of the FTP Results/ATP Results sheets into the first two columns of the Fail_Report_Table(A22:B22) and then the last two columns and paste into the last two columns of Fail_Report_Table (H22:I22).

我正在构建一个自定义模板供技术人员在生产层上使用。我要做的是过滤单独的表上的结果(FTP结果和ATP结果)，将这些结果复制到另一个表中特定列中的下一个空单元(失败报告)。我将FTP结果和ATP结果分别命名为range(结果和APTResults)和Failure Report (Fail_Report_Table)。我需要将FTP结果/ATP结果表的前两列粘贴到Fail_Report_Table的前两列(A22:B22)，然后将最后两列粘贴到Fail_Report_Table的最后两列(H22:I22)。

As for what I have right now, I can get it to work when only pulling from one sheet, but not both. I can get it to apply the advanced filter to both sheets, but it will only copy the results from ATP Results. I need to paste the filtered results from FTP Results first, find the next available cell in Columns A and H, then paste filtered results from ATP Results at that point. The number of filtered values will vary, so the solution has to be dynamic. I am relatively new to VBA and my code is a bit of a jumbled mess (and I am fairly sure that is part of the problem).

至于我现在所拥有的，我只需要从一张纸上拉出来就能让它工作，但不能同时从两张纸上拉出来。我可以让它将高级过滤器应用到两个表上，但它只复制ATP结果。我需要先粘贴来自FTP结果的过滤结果，在A和H列中找到下一个可用的单元格，然后粘贴来自ATP结果的过滤结果。过滤后的值的数量将会变化，所以解决方案必须是动态的。我对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

1 个解决方案

#1

I think all you need to do is find the next available row for each set of copy and paste you need, then use that row as a variable of where to place the data. See the code below (notice that you do not need to use Select all the time, but can just work directly with the object itself).

我认为你所需要做的就是为你需要的每一组拷贝和粘贴找到下一个可用的行，然后将这一行作为放置数据的变量。请参见下面的代码(注意，您不需要一直使用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