使用VBA将Excel中的空行复制到新工作表后删除它们

我已经成功地为Excel编写了VBA脚本，该脚本检查a列是否包含特定条目（在本例中为2016），然后将整行复制到新工作表中

Sub CopyRow()

Application.ScreenUpdating = False

Dim x As Long
Dim MaxRowList As Long
Dim S As String
Dim wsSource As Worksheet
Dim wsTarget As Worksheet


Set wsSource = ThisWorkbook.Worksheets("Tab 1")
Set wsTarget = ThisWorkbook.Worksheets("Tab 2")

aCol = 1
MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row

For x = 2 To MaxRowList
    If InStr(1, wsSource.Cells(x, 1), "2016") Then
    wsTarget.rows(x).Value = wsSource.rows(x).Value
    End If
Next

Application.ScreenUpdating = True

End Sub

唯一的问题是，它将行复制到与原始工作表中完全相同的位置。正因为如此，我在中间得到了空行。我希望宏在复制这些空行之后立即删除它们，或者将这些行一个接一个地复制到新工作表中

Sub CopyRow()

Application.ScreenUpdating = False

Dim x As Long
Dim MaxRowList As Long
Dim S As String
Dim wsSource As Worksheet
Dim wsTarget As Worksheet


Set wsSource = ThisWorkbook.Worksheets("Tab 1")
Set wsTarget = ThisWorkbook.Worksheets("Tab 2")

aCol = 1
MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row

For x = 2 To MaxRowList
    If InStr(1, wsSource.Cells(x, 1), "2016") Then
    wsTarget.rows(x).Value = wsSource.rows(x).Value
    End If
Next

Application.ScreenUpdating = True

End Sub

---

感谢您的帮助。提前感谢。

您可以像这样为目标行设置变量：

Sub CopyRow()

Application.ScreenUpdating = False

Dim x As Long
Dim MaxRowList As Long
Dim S As String
Dim wsSource As Worksheet
Dim wsTarget As Worksheet


Set wsSource = ThisWorkbook.Worksheets("Tab 1")
Set wsTarget = ThisWorkbook.Worksheets("Tab 2")

aCol = 1
MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row

destiny_row = 2 
For x = 2 To MaxRowList
    If InStr(1, wsSource.Cells(x, 1), "2016") Then
    wsTarget.rows(destiny_row).Value = wsSource.rows(x).Value
    destiny_row = destiny_row +1
    End If
Next

Application.ScreenUpdating = True

End Sub

---

这样，它将开始复制目标工作表第2行中的那些值，并根据if条件增加。告诉我它是如何进行的…

您可以使用

自动筛选方法，它将省去您在所有行中使用
For
循环的需要，只需将整个筛选范围复制到您的“选项卡2”工作表

Sub CopyRow()

Application.ScreenUpdating = False

Dim x As Long
Dim MaxRowList As Long
Dim S As String
Dim wsSource As Worksheet
Dim wsTarget As Worksheet


Set wsSource = ThisWorkbook.Worksheets("Tab 1")
Set wsTarget = ThisWorkbook.Worksheets("Tab 2")

aCol = 1
MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row

For x = 2 To MaxRowList
    If InStr(1, wsSource.Cells(x, 1), "2016") Then
    wsTarget.rows(x).Value = wsSource.rows(x).Value
    End If
Next

Application.ScreenUpdating = True

End Sub

Sub CopyRow()

    Application.ScreenUpdating = False

    Dim x As Long
    Dim MaxRowList As Long, PrintRow as Long
    Dim S As String
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet


    Set wsSource = ThisWorkbook.Worksheets("Tab 1")
    Set wsTarget = ThisWorkbook.Worksheets("Tab 2")

    aCol = 1
    MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row

    For x = 2 To MaxRowList
        If InStr(1, wsSource.Cells(x, 1), "2016") Then
            PrintRow = wsTarget.range("A" & wsTarget.rows.count).end(xlup).row
            wsTarget.rows(PrintRow).Value = wsSource.rows(x).Value
        End If
    Next

    Application.ScreenUpdating = True

End Sub

代码（注释内解释）

1.您可以为导出行2保留单独的行计数器。您可以使用.end（xlUp）（谷歌如何查找列中的最后一行），但请注意，这样做会失去检测是否已复制这些行的能力。如果使用#2运行宏两次，则会得到重复的宏。如果您使用行计数器进行导出，则可以覆盖任意次数。这非常有效！非常感谢你。你能再帮我一点忙吗？我需要完整的第一行才能从工作表1复制到工作表2的第1行。谢谢。：）当然，很高兴它有帮助，您只需使用“wsSource.rows（x）.EntireRow.Copy”，然后在目标中使用.paste。请记住，如果我的答案对您有帮助，请将其标记为正确。我在工作表上尝试了此代码，但它删除了工作表1中除第1行之外的所有条目。它对工作表2没有任何作用。@D.Todor还是被删除了？在我的代码中没有我删除的位置，因为某种原因，它没有复制a列中包含2016的所有行。它只复制了一行。在我的工作表中，A列有2个2016条目（分别位于A3和A7）。