首页 > 解决方案 > 根据单元格值将数据从一个工作表移动到另一个工作表

问题描述

我有一个电子表格“上传”我运行一个宏来编译工作表上的数据。我有一列“D”将数据归因于客户端。我想寻找一个特定的客户并自动将这些行移动到另一个工作表。我已经尝试过这段代码,但我犯了一个错误“Upload.Range("D1", Upload.Range("D" & Upload.Rows.Count)"

我预计未来的客户信息也需要与初始电子表格分开。

任何帮助将非常感激

Sub TransferData()

        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long

ar = Array("3032")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

  For i = 0 To UBound(ar)
         Upload.Range("D1", Upload.Range("D" & Upload.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 4, , 0
         lr = Upload.Range("D" & Rows.Count).End(xlUp).Row
         If lr > 1 Then
         Upload.Range("A2", Upload.Range("G" & Upload.Rows.Count).End(xlUp)).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
         Upload.Range("A2", Upload.Range("G" & Upload.Rows.Count).End(xlUp)).Delete
         Sheets(ar(i)).Columns.AutoFit
         End If
    Next i
[G1].AutoFilter

Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub

标签: excelvba

解决方案


工作表名称属性和工作表代号属性之间存在很大差异。

虽然可以更改工作表的代号,但这不是一种常见的做法,如果您不确定,那么您很可能指的是工作表名称属性。

您的叙述没有说明想要“后 10 个结果”,但您的代码将4用于 xlBottom10Items 运算符(请参阅xlAutoFilterOperator enumeration)。

我不知道3 inSheets(ar(i)).Range("A" & Rows.Count).End(3)(2)打算代表什么。我想您的意思是xlUp的数值为-4162。(参见xlDirection 枚举)。

Sub TransferData()

    Dim ar As Variant
    Dim i As Long, lr As Long

    ar = Array("3032")

    ' ... app environment settings removed for brevity

    'reference the filter worksheet properly
    With Worksheets("Upload")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        If .AutoFilterMode Then .AutoFilterMode = False
        For i = LBound(ar) To UBound(ar)
            'there was no mention of 'bottom 10 items in your narrative but your code shows that option
            With .Range("D1:D" & lr)
                '.AutoFilter field:=1, Criteria1:=ar(i), _
                            Operator:=xlBottom10Items, VisibleDropDown:=False
                .AutoFilter field:=1, Criteria1:=(ar(i)), VisibleDropDown:=False

                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        .Offset(0, -3).Resize(, 7).Copy _
                          Destination:=Worksheets(ar(i)).Range("A" & Rows.Count).End(xlUp)(2)
                        Worksheets(ar(i)).Columns.AutoFit
                        .Delete shift:=xlUp
                    End If
                End With
            End With
        Next i
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

    ' ... app environment settings removed for brevity

    MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub

那应该让你开始。根据我的笔记,您似乎还有一些决定要做。

Application.CutCopyMode = False

请参阅在退出子程序之前我应该​​重新打开 .CutCopyMode 吗?.


推荐阅读