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

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

这是我的代码：

' 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 – 返回一个数字不是一个位置来粘贴你的复制行

为它创build一个新的variables – 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没有有机会testing这个抱歉。