Почему мой макрос перестает копировать все данные строки после определенной точки?

Question

Я кодировал макрос Excel, который импортирует данные из CSV-файла, а затем копирует строки на основе проверенного значения и помещает проанализированные данные в отдельные листы.Я проверяю 12 значений и первые 9 работают, но как только он достигает 10, 11 и 12, макрос копирует только 1 строку.Это проблема с моим кодом или это ограничение Excel?Если это мой код, что я должен настроить?

Верхний модуль:

Sub Import_Parse_Refresh()
'Import Data CSV
    Call GetCSVList

'Parse Data Based on Report ID
    Call Data_Parse_All

'Refresh Each Pivot Table
    Call TableRefresh

'Delete Imported_Data that was created during the import
    Sheets("Imported_Data").Delete
    Sheets("Begin").Delete

'Save File As
    Call SaveFile

End Sub

Модуль Data_Parse_All:

Sub Data_Parse_All()

    Call Data_Parse_1
    Call Data_Parse_2
    Call Data_Parse_3
    Call Data_Parse_4
    Call Data_Parse_5
    Call Data_Parse_6
    Call Data_Parse_7
    Call Data_Parse_8
    Call Data_Parse_9
    Call Data_Parse_10
    Call Data_Parse_11
    Call Data_Parse_12

End Sub

Data_Parse_9 - этот код используется для всех 12Data_Parse_ # модули, но только с 1 по 9 работают правильно:

Sub Data_Parse_9()
'
    Sheets("Imported_Data").Select
    RowCount = Cells(Cells.Rows.Count, "I").End(xlUp).Row
    For i = 1 To RowCount
        Range("I" & i).Select
        check_value = ActiveCell
        If check_value = "9" Then
            ActiveCell.EntireRow.Cut
            Sheets("Report 9").Select
            RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
            Range("A" & RowCount + 1).Select
            ActiveSheet.Paste
            Sheets("Imported_Data").Select
        End If
    Next

End Sub

Data_Parse_10 -Код такой же, но это когда копируется только одна строка

Sub Data_Parse_10()
'
' Macro1_Data Macro
'
'assuming the data is in sheet1
    Sheets("Imported_Data").Select
    RowCount = Cells(Cells.Rows.Count, "I").End(xlUp).Row
    For i = 1 To RowCount
        Range("I" & i).Select
        check_value = ActiveCell
        If check_value = "10" Then
            ActiveCell.EntireRow.Cut
            Sheets("Report 10").Select
            RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
            Range("A" & RowCount + 1).Select
            ActiveSheet.Paste
            Sheets("Imported_Data").Select
        End If
    Next

End Sub

Answer 1

I думаю, , что вы можете свернуть все ваши Data_Parse_# сабы в один саб.Для этого потребуется check_value и использовать его для получения листа назначения.

Sub data_Parse()
Dim rowCount As Long, i As Long, newRowCount As Long
Dim check_value As String
Dim destSheet As Worksheet


With ThisWorkbook.Sheets("Imported_Data")
    rowCount = .Cells(Rows.Count, "I").End(xlUp).row
    For i = 1 To rowCount
        check_value = .Cells(i, "I").Value
        Set destSheet = ThisWorkbook.Sheets("Report " & check_value)
        newRowCount = destSheet.Cells(Rows.Count, "A").End(xlUp).row
        .Rows(i).EntireRow.Cut
        destSheet.Range("A" & newRowCount + 1).Paste
        Application.CutCopyMode = False
    Next i
End With ' .Sheets("Imported_Data")
End Sub

(Правка: я знаю с .Delete, при цикле (For i = rowCount to 1 Step -1) вы должны идти назад, но я 'я не уверен, требуется ли это с .Cut, поэтому просто убедитесь, что все строки учтены.)

Answer 2

Могу поспорить, что код, возвращающий нежелательные результаты, как-то связан с сбросом параметра To RowCount вашего цикла For-Next на другое, потенциально меньшее, значение в середине цикла.Например, если Column A из Sheets("Report 10") пусто, то RowCount будет сброшено до 1, что приведет к выходу из цикла после первой итерации.Кроме того, как упомянул @urdearboy, вы можете объединить это в один динамический цикл.Я бы попробовал что-то вроде

Sub Data_Parse_All()
    Dim i As Long
    Dim Rowcount As Long
    Dim PasteRow As Long

    With Sheets("Imported_Data")
        Rowcount = .Cells(.Cells.Rows.Count, "I").End(xlUp).Row
        For i = 1 To Rowcount
            If .Range("I" & i) >= 1 And .Range("I" & i) <= 12 Then
                PasteRow = Sheets("Report " & .Range("I" & i)).Range("I" & Rows.Count).End(xlUp).Row + 1
                .Range("I" & i).EntireRow.Cut Sheets("Report " & .Range("I" & i)).Range("A" & PasteRow)
            End If
        Next i
    End With
End Sub