VBA неработающая копия

Question

Я некоторое время использовал этот код в рабочей книге, ушел и вернулся, чтобы вернуться, и обнаружил, что код больше не функционирует, как раньше.Я не вижу никаких очевидных ошибок и задавался вопросом, может ли кто-нибудь определить, что, возможно, остановит его работу?

Имена и местоположения страниц остаются прежними.

Цель состояла в том, чтобы получить результаты на листе 4 (CAL) и скопировать каждую строку в новую пустую строку в RRR.Ошибки не отображаются.Просто ничего не происходит вообще.

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

Answer 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

Упрощение

Константы в начале кода являются спасателями, как вы, вероятно, скоро увидите.

Это обычноосвободить объектные переменные , когда они больше не нужны или, по крайней мере, вnd кода.В следующих кодах не используются никакие переменные объекта, что достигается с помощью свойства 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
'*******************************************************************************