Excel VBA-减少执行剪切操作的运行时间

我希望有人有一个方法，以显着减少时间，下面的代码需要完成。我有一个工作表，其中包含打开文件并从该文件导入数据的代码。没有问题。下面的代码将在A列中搜索特定的人名，当找到该人名时，它会将该行剪切并粘贴到相应的工作表中。执行此代码需要几分钟。每行的A、B和C列中始终包含数据。D、E、F列中可能包含日期，也可能不包含日期。当前，导入文件大约有1200行，并且将不断增加。无论如何，要提高这一行动的效率

Private Sub CommandButton1_Click()
    Dim sh As Worksheet, ws As Worksheet
    Dim rws As Long, rng As Range, c As Range

    Set sh = Worksheets("data")
    Set aa = Worksheets("aamory")
    Set bg = Worksheets("bglesing")
    Set da = Worksheets("damory")
    Set Db = Worksheets("dbutzer")
    Set dd = Worksheets("ddelnero")
    Set dm = Worksheets("dmacmaster")
    Set er = Worksheets("erose")
    Set gr = Worksheets("gragonese")
    Set jg = Worksheets("jgabbard")
    Set lw = Worksheets("lwhite")
    Set kc = Worksheets("kcarter")
    Set lw = Worksheets("lwhite")
    Set mb = Worksheets("mbrooks")
    Set rg = Worksheets("rgallese")
    Set sp = Worksheets("spolk")
    Set sb = Worksheets("sbrooks")

    With sh
        rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rng = .Range(.Cells(1, 1), .Cells(rws, 1))
    End With

    For Each c In rng.Cells

        If c = "aamory" Then
            c.EntireRow.Cut Destination:=aa.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "bglesing" Then
            c.EntireRow.Cut Destination:=bg.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "damory" Then
            c.EntireRow.Cut Destination:=da.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "dbutzer" Then
            c.EntireRow.Cut Destination:=Db.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "ddelnero" Then
            c.EntireRow.Cut Destination:=dd.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "dmacmaster" Then
            c.EntireRow.Cut Destination:=dm.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "erose" Then
            c.EntireRow.Cut Destination:=er.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "gragonese" Then
            c.EntireRow.Cut Destination:=gr.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "jgabbard" Then
            c.EntireRow.Cut Destination:=jg.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "lwhite" Then
            c.EntireRow.Cut Destination:=lw.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "kcarter" Then
            c.EntireRow.Cut Destination:=kc.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "mbrooks" Then
            c.EntireRow.Cut Destination:=mb.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "rgallese" Then
            c.EntireRow.Cut Destination:=rg.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "spolk" Then
            c.EntireRow.Cut Destination:=sp.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        If c = "sbrooks" Then
            c.EntireRow.Cut Destination:=sb.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If

       Next c
Application.ScreenUpdating = True
End Sub

---

这将更适合于。使用case语句或elseifs可能更快，因为如果它与一个匹配，则不会与其他语句进行检查。可能是useful@Warcupine：实际上不是。这是两个站点的主题：）您可能想查看和，但不能剪切非连续范围。所以1。跨2复制筛选的行。复制后删除筛选的行