将行移动到另一个工作表，其中单元格等于工作表名称

Question

我对 VB 很陌生。请有人告诉我如何将一行移动到另一个工作表，其中单元格值等于另一个工作表的名称。

基本上......在我的第一个工作表（所有数据）中，我有一系列从 SQL 脚本填充的数据。在 A 栏中，有为我们公司工作的 CS 代表的姓名。每个 CS 代表都有自己的工作表。

我需要 VB 检查单元格 A2（所有数据）并将单元格范围 A2:M2 移动到相应 CS Rep 工作表的 A2:M2。然后应该删除（所有数据）中的行。

此过程需要循环进行，直到“所有数据”中的所有行都移动到相应的 CS 代表的工作表中。 任何不匹配都可以移至另一个名为“不匹配”的工作表。匹配的行应始终复制到相应工作表的第 2 行，将现有数据向下移动一行。

我真的希望这是有道理的！？！

谢谢 SMORF

Sub MoveToCS()

Sheets("All Data").Select
Cells.Select
ActiveWorkbook.Worksheets("All Data").sort.SortFields.Clear
ActiveWorkbook.Worksheets("All Data").sort.SortFields.Add Key:=Range( _
    "A2:A357"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("All Data").sort
    .SetRange Range("A1:M357")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$M$1000").AutoFilter Field:=1, Criteria1:="ACHAL"
Range("A2:M1000").Select

Selection.Copy
Sheets("ACHAL").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("All Data").Select
Selection.EntireRow.Delete
ActiveSheet.Range("$A$1:$M$286").AutoFilter Field:=1

结束子

Answer 1

我将使用下一个：

ActiveCell.EntireRow.Insert '这将插入一个新行，在这种情况下[“匹配的行应始终复制到相应工作表的第 2 行，将现有数据向下移动一行”]

Activecell.EntireRow.Copy '这将复制所有活动行。

ActiveCell.PasteSpecial '这会将数据粘贴到剪贴板中，请确保此行在复制行之后。

ActiveCell.EntireRow.Delete '这样您就可以从包含 MySQL 数据源的工作表中删除数据。

据此，我认为您不需要对数据进行排序，只需创建一个循环来移动工作表的整个第一列（所有数据），以及一个评估 activecell 值并取决于数据的开关选择特定工作表并粘贴信息，粘贴后返回主工作表，删除活动单元格并循环，如下所示：

Sub Main()
    Sheets("All Data").Activate
    Range("A2").Activate
    Dim SheetToPaste As String
    Do While ActiveCell.Value <> ""
        Select Case ActiveCell.Value
            Case "Hoja2"
                SheetToPaste = "Hoja2"
            Case "Hoja3"
                SheetToPaste = "Hoja3"
            Case Else
                SheetToPaste = "Mismatch"
        End Select
        ActiveCell.EntireRow.Copy
        Sheets(SheetToPaste).Activate
        Range("A2").Activate
        ActiveCell.EntireRow.Insert
        Application.CutCopyMode = False
        Sheets("All Data").Activate
        ActiveCell.EntireRow.Delete
    Loop
End Sub

希望它有效。