将行从工作表复制到新工作表结尾Excel VBA

Question

我在Excel中使用vba创建宏。 我有一个for循环遍历所有行，并将符合条件的特定行复制到新工作表。目前，这个宏的工作原理，我把它复制到相同的行号，但这导致空行存在，我摆脱了。有没有办法通过将行复制到最后一次使用的行之后来做到这一点？

这里是我的代码：

' Set the lastRow variable 
    lastRow = Worksheets("Original").Cells.Find("*", [A1], , , xlByRows, xlPrevious).ROW 

    ' The Total is in column K and the Class is in Column C 
    On Error Resume Next 
    For i = lastRow To 1 Step -1 
     ' Check the columns for Total and Class values 
     If (Worksheets("Original").Cells(i, "K").Value2) <> 0 Then 
      Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(i, 1) 
      'Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW 
     ElseIf ((Worksheets("Original").Cells(i, "K").Value2) = 0) Then 
      If (Worksheets("Original").Cells(i, "C").Value2) < 81 Or (Worksheets("Original").Cells(i, "C").Value2) > 99 Then 
       Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(i, 1) 
       'Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW 
      End If 
     End If 
    Next i 
Worksheets("NEW WS").Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

注释行： Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW

不要工作。我不知道为什么。当我尝试使用此代码时，Excel不会将原始工作表中的任何内容复制到新工作表中。 我怎样才能使它工作？

Answer 1

继我的意见，请参阅本

UNTESTED

Option Explicit 

Sub sample() 
    Dim wsO As Worksheet, wsI As Worksheet 
    Dim wsOLRow As Long, wsILRow As Long 

    Set wsO = ThisWorkbook.Worksheets("NEW WS") 
    Set wsI = ThisWorkbook.Worksheets("Original") 

    With wsO 
     If Application.WorksheetFunction.CountA(.Cells) <> 0 Then 
      wsOLRow = .Cells.Find(What:="*", _ 
          After:=.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row + 1 
     Else 
      wsOLRow = 1 
     End If 
    End With 

    With wsI 
     wsILRow = .Range("A" & .Rows.Count).End(xlUp).Row 
     For i = 1 To wsILRow 
      If .Cells(i, "K").Value2 <> 0 Then 
       .Rows(i).Copy wsO.Rows(wsOLRow) 
       wsOLRow = wsOLRow + 1 
      ElseIf .Cells(i, "K").Value2 = 0 Then 
       If .Cells(i, "C").Value2 < 81 Or .Cells(i, "C").Value2 > 99 Then 
        .Rows(i).Copy wsO.Rows(wsOLRow) 
        wsOLRow = wsOLRow + 1 
       End If 
      End If 

     Next i 
    End With 
End Sub 

Answer 2

Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW - 返回一个数字，不粘贴复制的行

的位置为它创建一个新的变量 - newLastRow = Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW

然后，当你想复制粘贴：

Worksheets("Original").Rows(i).EntireRow.Copy Worksheets("NEW WS").Range("A" & CStr(newLastRow + 1)).EntireRow应该工作或者没有.EntireRow没有机会测试这个抱歉。