在使用VBA复制到新工作表后，删除Excel中的空行

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

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

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 

任何帮助表示赞赏。 提前致谢。

Answer 1

你可以像这样为目标行设置一个variables：

 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行，并将增加根据条件。告诉我如何去…

Answer 2

您可以使用AutoFilter方法，它将为您节省在所有行中使用For循环的需要，并将整个过滤的范围复制到“Tab 2”工作表中。

代码 （注释中的解释）

 Option Explicit Sub CopyRow() Application.ScreenUpdating = False Dim x As Long Dim MaxRowList As Long Dim MaxCol As Long Dim S As String Dim aCol As Long Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim SourceRng As Range Dim VisRng As Range Set wsSource = ThisWorkbook.Worksheets("Tab 1") Set wsTarget = ThisWorkbook.Worksheets("Tab 2") aCol = 1 With wsSource MaxRowList = .Cells(.Rows.Count, aCol).End(xlUp).Row ' find last row MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' find last column Set SourceRng = .Range(.Cells(1, 1), .Cells(MaxRowList, MaxCol)) ' set source range to actually occupied range .Range("A1").AutoFilter ' use AutoFilter method SourceRng.AutoFilter Field:=1, Criteria1:="2016" Set VisRng = SourceRng.SpecialCells(xlCellTypeVisible) ' set range to filterred range VisRng.Copy ' copy entire visible range wsTarget.Range("A2").PasteSpecial xlPasteValues ' past with 1 line End With Application.ScreenUpdating = True End Sub 

Answer 3

 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