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

我编写了以下Excel VBA宏，它的工作是基于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

解决了

我使用了@sous2817推荐的过滤器 它不是运行几个小时，而是在2分钟内完成整个工作：D

谢谢你的帮助

---

问题已经在这里解决了：

您不能只按国家名称或代码过滤并复制可见的行，而不是循环遍历每一行吗？只需建立一个独特的县名列表，并循环使用即可。这样做，你就不必担心空行，而且速度会快得多。下一步拿出你的错误简历，看看它是否会消除错误。我的猜测是，它正在这样做，并跳过循环结束语句。狡猾的。您的代码看起来不错，但是为什么不使用范围变量替换使用ActiveCell在循环之前设置为ActiveCell，然后使用偏移量调整范围变量，就像您现在稍后所做的那样。通过这种方式，您可以更确定活动单元格不会意外更改。。