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

Posted 2023-02-23

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

【英文标题】：Move Row to another worksheet where cell equals worksheet name

【发布时间】：2014-07-08 13:03:44

【问题描述】：

我对 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

结束子

【问题讨论】：

这种类型的一对多在 VBA 中非常可行，而且您在概述和理解问题方面做得很好。请使用您迄今为止尝试过的代码更新您的问题，我们将能够从那里为您提供帮助

嗨，我只有一个代码来对我的“所有数据”过滤器进行排序，只显示一个 CS 代表，复制范围，移动到相应的工作表，插入单元格，移动回“所有数据”删除范围并删除排序（添加到原始问题的代码）。

【参考方案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

希望它有效。

【讨论】：

嗨，我刚刚尝试了代码......它工作得很好。感谢“ActiveCell”定义，我将能够将它们用于我的 VB 项目的其他方面。非常感谢。