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

3 回答

• 0

  您可以为目标行设置变量，如下所示：

  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条件增加 . 告诉我它是怎么回事......

  回复于 2024-04-28T19:32:33+08:00
• 1

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

  Code （评论内部评论）

  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
  

  回复于 2024-04-28T19:32:33+08:00
• 1

  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
  

  回复于 2024-04-28T19:32:33+08:00