首页 文章

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

提问于
浏览
2

我在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将不会将任何内容从原始工作表复制到新工作表 . 我怎样才能让它发挥作用?

2 回答

  • 3

    继我的评论之后,请看这个

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

相关问题