Excel 在筛选后循环可见行（&A）；根据条件复制到另一张图纸

如果B列为空，我想在筛选后将所有可见行从sheet1 table1复制到sheet2 table2。下面的代码只将最后一个数据复制到另一个工作表，它将复制到表的其余部分

Sub Send()
Dim i As Integer, j As Integer, k As Integer
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim visRng As Range ' Creating a range variable to store our table, excluding any rows that are filtered out.

Set wsCopy = Application.ThisWorkbook.Worksheets("Sheet1")
Set wsDest1 = Application.ThisWorkbook.Worksheets("Sheet2")

MsgBox "Sending Form...."

Set visRng = Range("Table1").SpecialCells(xlCellTypeVisible) 'Check all visible Rows in Table1

Dim r As Range

For Each r In visRng.Rows ' Loop through each row in our visible range ...
  'MsgBox (r.Row) ' ... and retrieve the "absolute" row number.

 If wsCopy.Cells(r.Row, 2).Value = "" Then
  wsCopy.Range("A" & r.Row).Copy 
  wsDest1.Range("Table2").Columns(1).PasteSpecial
 End If

 Next

End Sub 

这是样品过滤器

这是我在中的代码的结果

预期结果：

这应该可以：

Sub Send()
    Dim i As Integer, j As Integer, k As Integer
    Dim wsCopy As Worksheet
'IN THE CODE wsDest WAS CALLED wsDest1. I CHANGED THE REFERENCES IN THE CODE. I'D SUGGET YOU TO USE Option Explicit.
    Dim wsDest As Worksheet
    Dim visRng As Range ' Creating a range variable to store our table, excluding any rows that are filtered out.
'ADDED A NEW VARIABLE
    Dim DblRow As Double
    
    Set wsCopy = Application.ThisWorkbook.Worksheets("Sheet1")
    Set wsDest = Application.ThisWorkbook.Worksheets("Sheet2")
    
    MsgBox "Sending Form...."
'CHANGED visRng TO TARGET ONLY THE FIRST COLUMN OF Table1. NO NEED TO INCLUDE THE REST OF THE TABLE; IT WOULD ONLY MAKE OUR EXECUTION LONGER
    Set visRng = Range("Table1").Columns(1).SpecialCells(xlCellTypeVisible) 'Check all visible Rows in Table1
'YOU SHOULD PUT THIS DECLARATION AT THE BEGINNING. ALSO I'D SUGGEST NOT TO USE A SINGLE LETTER VARIABLE. wsDest IS A GOOD NAME FOR A VARIABLE.
    Dim r As Range
'SETTING THE VARIABLE.
    DblRow = 1
    
    For Each r In visRng.Rows ' Loop through each row in our visible range ...
        'MsgBox (r.Row) ' ... and retrieve the "absolute" row number.
        
        If wsCopy.Cells(r.Row, 2).Value = "" Then
            wsCopy.Range("A" & r.Row).Copy
'YOUR CODE DIDN'T SCROLL THE TABLE 2. USING DBLROW IN .Cells YOU CAN DO IT.
            wsDest.Range("Table2").Cells(DblRow, 1).PasteSpecial
            DblRow = DblRow + 1
        End If
        
    Next

End Sub

通过适当注释突出显示的编辑

---

报告您遇到的任何问题或bug。根据您的判断，如果这个答案（或任何其他答案）是您问题的最佳解决方案，您有权接受它（）。

您需要准确复制哪些数据？因为这两个表的标题不同。数据来自列A@bluemonkey