报表拆分 - Excel VBA不会复制所有行并且不确定地运行

我编写了以下Excel VBA宏，其工作是根据CountryCode拆分报表 . 它创建一个新工作簿，将相关行复制到新工作簿，通过CountryCode保存工作簿 .

我遇到的问题是缺少行和一个工作表，它继续在空行上运行？ - 基本上它不会停止并复制空行 .

单元格格式化与它有什么关系吗？

还有另一个只运行一次的宏，它首先创建工作簿 . 它只在第一个工作表上运行一次，永远不会再运行一次 .

Sub RUN2_ReportSplitterOptimized()

Application.DisplayAlerts = False
Application.EnableEvents = False
' Current Workbook
    Dim cW As Workbook
    Dim cWL As String
    Dim cWN As String

    Set cW = ThisWorkbook
    cWL = cW.Path
    cWN = cW.Name

' Current Worksheet
    Dim cS As Worksheet
    Set cS = ActiveSheet

    Do Until IsEmpty(ActiveCell)

' Current Active Cell
        Dim aC As Range
        Set aC = ActiveCell

' Split input string
        Dim CC As String
        CC = splitCC(aC.Text)

        Dim wb As Workbook
        Dim ws As Worksheet

        On Error Resume Next
        Set wb = Workbooks(CC & ".xlsx")
        If Err.Number <> 0 Then
            Set wb = Workbooks.Open(cWL & "\" & CC & ".xlsx")
            ' Create the worksheet
            Set ws = wb.Sheets.Add
            ' Copy the row to the worksheet
            ws.Rows(1).Value = cS.Rows(1).Value
            ws.Rows(2).Value = aC.EntireRow.Value

            With ws
                .Name = cS.Name
            End With
        Else
            wb.Activate
            On Error Resume Next
            Set ws = wb.Sheets(cS.Name)
            If Err.Number <> 0 Then
                Set ws = wb.Sheets.Add
                ' Copy the row to the worksheet
                ws.Rows(1).Value = cS.Rows(1).Value
                ws.Rows(2).Value = aC.EntireRow.Value
                With ws
                    .Name = cS.Name
                End With
            Else
            LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            ws.Rows(LastRow + 1).Value = aC.EntireRow.Value
            End If
        End If
    wb.Save
    cW.Activate
    aC.Offset(1, 0).Select
    Loop
Dim wbk As Workbook
For Each wbk In Workbooks
    If Len(wbk.Name) = 7 Then
        wbk.Close
    End If
Next
End Sub

Function splitCC(countrycode As String) As String
If Len(countrycode) < 3 Then
    splitCC = countrycode
Else
    splitCC = Mid(countrycode, InStr(countrycode, "(") + 1, 2)
End If
End Function