Question

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

基本上......在我的第一个工作表（All Data）中，我有一系列从SQL脚本填充的数据。在A栏中，有适用于我们公司的CS Reps的名称。每个CS Rep都有自己的工作表。

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

此过程需要循环，直到“所有数据”中的所有行为止。已移至相应的CS Rep工作表。任何不匹配都可以转移到另一个名为“Mismatch＆＃39;”的工作表。匹配的行应始终复制到相应工作表的第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

End Sub

Answer 1

我将使用下一个：

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

Activecell.EntireRow.Copy＆＃39;这将复制所有有效行。

ActiveCell.PasteSpecial＆＃39;这会将数据粘贴到剪贴板中，确保此行位于复制行之后。

ActiveCell.EntireRow.Delete＆＃39;使用此功能，您可以从包含MySQL数据源的工作表中删除数据。

根据这个，我认为你不需要订购数据，只需创建一个循环来移动工作表的整个第一列（所有数据），以及一个评估activecell值并依赖于数据的开关选择特定工作表并粘贴信息，粘贴后，返回主工作表，删除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

希望它有效。

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

1 个答案: