使用VBA搜索和复制Excel数据

我正在编写一个VBA程序来搜索一个大的电子表格，并将具有相同帐户的行（与数据关联五次或五次以上）复制到不同的工作表中。当我一步一步地通过每一行（F8）时，程序会执行它应该执行的操作，但当我运行程序（F5）时，它不会将任何信息复制到第二页。我曾尝试在切换工作表和粘贴数据之间增加两秒钟的延迟，以防万一这是个问题，但到目前为止没有任何帮助

有什么建议吗

编辑：我认为屏幕更新可能是导致问题的原因，所以我禁用了它。程序仍然没有将数据粘贴到其他工作表中

第二次编辑：我注意到，当我在while循环的开始处设置一个stop，并将程序分块执行时，它也不会像应该的那样复制和粘贴数据。但是，当单步执行代码行时，它仍然有效。我还取消了2秒钟的暂停，因为这些都没有什么不同

代码如下：

Public Sub Main()
Worksheets(2).Activate
Range("A1").Select
Worksheets(1).Activate
Range("C2").Select
AcctName = ActiveCell.Value
LoopControl = 0
AcctNameCt = 1
CurrentAcctRow = ActiveCell.Row

Do While LoopControl <> 1

    SecondLoopControl = 0
    If AcctName = ActiveCell.Offset(AcctNameCt, 0).Value Then
        AcctNameCt = AcctNameCt + 1
        If AcctNameCt > 4 Then
        GreaterThanFour
        End If
    ElseIf ActiveCell.Offset(AcctNameCt, 0).Value = "" Then
        Exit Do
    Else
        ActiveCell.Offset(AcctNameCt, 0).Activate
        AcctName = ActiveCell.Value
        AcctNameCt = 1
        CurrentAcctRow = ActiveCell.Row
    End If
Loop
End Sub

Public Sub CopyData()
    Dim EndRow As Integer
    Dim StopCopy As Integer
    Dim RestartRow As Integer
    EndRow = CurrentAcctRow + AcctNameCt
    StopCopy = EndRow - 1
    RestartRow = EndRow + 1
    ActiveSheet.Range("C" & CurrentAcctRow & ":" & "C" & StopCopy).EntireRow.Copy
    Worksheets(2).Activate
    LookForEmptyRow
    ActiveCell.EntireRow.PasteSpecial
    CurrentAcctRow = CurentAcctRow + 1
    Worksheets(1).Activate
    Range("C" & EndRow).Select
    AcctNameCt = 0

End Sub

Public Sub GreaterThanFour()
    Do While SecondLoopControl <> 1
        If AcctName = ActiveCell.Offset(AcctNameCt, 0).Value Then
            AcctNameCt = AcctNameCt + 1
        Else
            CopyData
            SecondLoopControl = 1
        End If
    Loop
End Sub

Public Sub LookForEmptyRow()
    Range("A1").Select
    Dim LookAnotherLoopControl As Integer
    LookAnotherLoopControl = 0
    Do While LookAnotherLoopControl <> 1
        If ActiveCell.Value = "" Then Exit Sub Else ActiveCell.Offset(1, 0).Activate
    Loop
End Sub

Public Sub-Main（）
工作表（2）。激活
范围（“A1”）。选择
工作表（1）。激活
范围（“C2”）。选择
AcctName=ActiveCell.Value
LoopControl=0
AcctName=1
CurrentAcctRow=ActiveCell.Row
执行循环控制1
SecondLoopControl=0
如果AcctName=ActiveCell.Offset（AcctName，0）.Value，则
账户名称=账户名称+1
如果AcctName>4，则
四岁以上
如果结束
ElseIf ActiveCell.Offset（acctname，0）.Value=”“然后
退出Do
其他的
ActiveCell.Offset（AcctName，0）。激活
AcctName=ActiveCell.Value
AcctName=1
CurrentAcctRow=ActiveCell.Row
如果结束
环
端接头
公共子副本数据（）
作为整数的Dim EndRow
将StopCopy设置为整数
将RestartRow设置为整数
EndRow=CurrentAcctRow+AcctNameCt
StopCopy=EndRow-1
RestartRow=EndRow+1
ActiveSheet.Range（“C”和CurrentAcctRow&“：”和“C”和StopCopy）.EntireRow.Copy
工作表（2）。激活
LookForEmptyRow
ActiveCell.EntireRow.PasteSpecial
CurrentAcctRow=CurrentAcctRow+1
工作表（1）。激活
范围（“C”和结束行）。选择
AcctName=0
端接头
公共分公司
执行第二次循环控制1
如果AcctName=ActiveCell.Offset（AcctName，0）.Value，则
账户名称=账户名称+1
其他的
复制数据
SecondLoopControl=1
如果结束
环
端接头
公共子目录
范围（“A1”）。选择
Dim LookAnotherLoopControl作为整数
LookAnotherLoopControl=0
查看另一个循环控件时执行此操作1
如果ActiveCell.Value=”“，则退出Sub-Else ActiveCell.Offset（1，0）。激活
环
端接头

我将工作表名称设置为变量并调用它们，而不是直接调用工作表。出于某种原因，这种方法效果更好

 Set wbA = Workbooks(Workbook Name)
 Set wsA = Worksheets(Worksheet Name 1)
 Set wsB = Worksheets(Worksheet Name 2)

其中，“工作簿名称”和“工作表名称1”反映实际名称。这些措施比：

Worksheets(2).Activate
LookForEmptyRow
ActiveCell.EntireRow.PasteSpecial
CurrentAcctRow = CurentAcctRow + 1
Worksheets(1).Activate
Range("C" & EndRow).Select

我还使用了更好的方法查找空行，而不是编写自己的子例程。原始代码中有我编写的子代码：

 Public Sub LookForEmptyRow()
    Range("A1").Select
    Dim LookAnotherLoopControl As Integer
    LookAnotherLoopControl = 0
    Do While LookAnotherLoopControl <> 1
        If ActiveCell.Value = "" Then Exit Sub Else ActiveCell.Offset(1, 0).Activate
    Loop

lRow = Range("A1000").End(xlUp).Row
Cells(lRow + 1, 1).Activate