VBA损坏的复制粘贴循环

时间:2018-12-13 15:22:06

标签: excel vba loops

我在工作簿中使用此代码已有一段时间,然后离开并再次进行访问,发现该代码不再像以前那样起作用。我看不到任何明显的错误,并且想知道是否有人可以发现阻止它运行的原因?

页面名称和位置保持不变。

目的是在工作表4(CAL)中取得结果,并将每行复制到一次存款准备金中的新空行中。没有错误显示。根本没有任何反应。

Sub ca_act()
    Dim nextrow As Long
    nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1

    Dim src As Worksheet
    Set src = Sheets("CAL")

    Dim trgt As Worksheet
    Set trgt = Sheets("RRR")

    Dim i As Long
      For i = 1 To src.Range("y" & Rows.Count).End(xlUp).Row
        If src.Range("y" & i) = 1 Then
            ' calling the copy paste procedure
            CopyPaste src, i, trgt
        End If
    Next i
Application.ScreenUpdating = True
End Sub

' this sub copies and pastes the entire row into a different sheet
' below the last used row
Private Sub CopyPaste(ByRef src As Worksheet, ByVal i As Long, ByRef trgt As Worksheet)
    src.Activate
    src.Rows(i & ":" & i).Copy
    trgt.Activate
    Dim nxtRow As Long
    nxtRow = trgt.Range("y" & Rows.Count).End(xlUp).Row + 1
    trgt.Rows(nxtRow & ":" & nxtRow).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

1 个答案:

答案 0 :(得分:1)

错误的工作表或列

一些猜想的工作

以下行表示您将检查“ A”列中的值

Dim nextrow As Long
nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1

这可能是您的第一个主意。顺便说一句,您应该将其注释掉,因为它没有用。

以后写

For i = 1 To src.Range("Y" & Rows.Count).End(xlUp).Row

,这意味着您正在检查列“ Y”。你确定吗?

我会考虑以下内容:

  
      
  • 您正在检查错误列中的值。
  •   
  • 您的工作表CAL和$ RRR可能有误,例如,您已将CAL的名称更改为到没有数据的Sheet2。
  •   
  • 在“ RRR”工作表中,“ Y”列下方可能有一些不需要的数据;即,如果您不小心在某个单元格中放入一些数据,则该数据将在该单元格处停下来并向下一行写入在那里,您没有看到它。
  •   
  • 这是在不同的工作簿中发生的。
  •   

这是怎么回事

Application.ScreenUpdating = True

何时

Application.ScreenUpdating = False

无处可寻。

这是第二个子代码的简化:

Private Sub CopyPaste(src As Worksheet, i As Long, trgt As Worksheet)
    src.Rows(i).Copy (trgt.Rows(trgt.Range("Y" & Rows.Count).End(xlUp).Row + 1))
End Sub

简化

代码开头的

常量是救生员,您可能很快就会看到。

习惯上在不再需要或至少在代码末尾释放对象变量。以下代码不使用通过 Parent属性实现的任何对象变量。

'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row, using
' the CopyPaste_Simple Sub.
'*******************************************************************************
Sub ca_act_Simple()

    Application.ScreenUpdating = False

    Const strSource As Variant = "CAL"      ' Source Worksheet Name/Index
    Const strTarget As Variant = "RRR"      ' Target Worksheet Name/Index
    Const vntSourceCol As Variant = "Y"     ' Source Column Letter/Number
    Const lngSourceRow As Long = 1          ' Source First Row
    Const vntSearch as Variant = 1          ' Search Value

    Dim intRow As Long                      ' Row Counter

    With ThisWorkbook.Worksheets(strSource)
        For intRow = lngSourceRow To _
                .Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
            If .Cells(intRow, vntSourceCol) = vntSearch Then
                ' calling the copy paste procedure
                CopyPaste_Simple .Parent.Worksheets(strSource), intRow, _
                    .Parent.Worksheets(strTarget)
            End If
        Next
    End With

    Application.ScreenUpdating = True

End Sub
'*******************************************************************************

'*******************************************************************************
' Copies the entire row to another worksheet below its last used row calculated
' from a specified column.
'*******************************************************************************
Sub CopyPaste_Simple(Source As Worksheet, SourceRowNumber As Long, _
        Target As Worksheet)

    ' It is assumed that the Target Worksheet has headers i.e. its first row
    ' will never be populated.

    Const vntTargetCol As Variant = "Y"     ' Target Column Letter/Number

    With Target
        Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
            vntTargetCol).End(xlUp).Row + 1))
    End With

End Sub
'*******************************************************************************

改进

为了改进,我们将删除第二个子代码:

'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row
' calculated from a specified column.
'*******************************************************************************
Sub ca_act_Improve()

    Application.ScreenUpdating = False

    Const strSource As Variant = "CAL"      ' Source Worksheet Name/Index
    Const strTarget As Variant = "RRR"      ' Target Worksheet Name/Index
    Const vntSourceCol As Variant = "Y"     ' Source Column Letter/Number
    Const vntTargetCol As Variant = "Y"     ' Target Column Letter/Number
    Const lngSourceRow As Long = 1          ' Source First Row
    Const vntSearch as Variant = 1          ' Search Value         

    Dim intRow As Long                      ' Row Counter

    With ThisWorkbook.Worksheets(strSource)
        For intRow = lngSourceRow To _
                .Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
            If .Cells(intRow, vntSourceCol) = vntSearch Then
                With .Parent.Worksheets(strTarget)
                    .Parent.Worksheets(strSource).Rows(intRow).Copy _
                    (.Rows(.Cells(.Rows.Count, vntTargetCol).End(xlUp).Row + 1))
                End With
            End If
        Next
    End With

    Application.ScreenUpdating = True

End Sub
'*******************************************************************************

在此改进的版本中,最明显的是您在两个工作表中都使用了“ Y”列,这可能是造成麻烦的原因。

第二小组

我认为最好添加第四个参数:

'*******************************************************************************
' Copies an entire row to another worksheet below its last used row.
'*******************************************************************************
Sub CopyPaste_Improve(Source As Worksheet, SourceRowNumber As Long, _
        Target As Worksheet, TargetColumnLetterNumber As Variant)

    ' It is assumed that the Target Worksheet has headers i.e. its first row
    ' will never be populated.

    With Target
        Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
            TargetColumnLetterNumber).End(xlUp).Row + 1))
    End With

End Sub
'*******************************************************************************