Question

我正在建立一个自定义模板供技术人员在生产车间使用。我试图做的是在单独的工作表上过滤结果（FTP结果和ATP结果），将这些结果复制到另一个工作表中特定列中的下一个空单元格（失败报告）。我将FTP结果和ATP结果分别作为命名范围（结果和APTResults）和失败报告（Fail_Report_Table）。我需要将FTP结果/ ATP结果表的前两列粘贴到Fail_Report_Table（A22：B22）的前两列，然后粘贴到最后两列，并粘贴到Fail_Report_Table的最后两列（H22：I22）。

至于我现在拥有的东西，我只能从一张纸上拉，但不能同时拉两张纸。我可以将高级过滤器应用于两个工作表，但它只会复制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

Answer 1

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

将过滤后的结果粘贴到列

1 个答案: