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没有机会测试这个抱歉。

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

2 个答案: