复制单元格与工作表名称匹配的行

Question

我有以下代码将行移动到特定工作表，其中M列中的单元格值等于值：“未计划”

Sub Not_Planned()

Sheets("All Data").Select

RowCount = Cells(Cells.Rows.count, "a").End(xlUp).Row

For i = 1 To RowCount

    Range("M" & i).Select
    check_value = ActiveCell

    If check_value = "not planned" Then
        ActiveCell.EntireRow.Copy
        Sheets("Not Planned").Select
        RowCount = Cells(Cells.Rows.count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("All Data").Select
        Range("A2").Select
    End If

Next

End Sub

有没有办法修改代码，使其遍历所有行并将行复制到工作表，其中A列中的值等于工作表名称？

请注意：我已经有一个代码来创建工作表并根据A列中的唯一值来命名它们。

谢谢

Answer 1

编辑......显然，你可以使用RowCount的两倍，并改变它中期循环 。 这不是很好的做法，因为该变量来自两个不同的工作表，但从技术上讲，它将起作用。

首先，请停止使用SELECT

其次，这应该做到这一点（仅当您要将“未计划的”项目移动到另一张工作表时）：

Sub Not_Planned()

Dim DataSht As Worksheet, DestSht As Worksheet

Set DataSht = Sheets("All Data")

RowCount = DataSht.Cells(Cells.Rows.count, "A").End(xlUp).Row

For i = 2 To RowCount

    check_value = DataSht.Range("M" & i).Value

    If check_value = "not planned" Then
        DataSht.Range("M" & i).EntireRow.Copy
        Set DestSht = Sheets(DataSht.Range("A" & i).Value)
          'You might want some error handling here for if the Sheet doesn't exist!
        DestLast = DestSht.Cells(Cells.Rows.count, "a").End(xlUp).Row
        DestSht.Range("a" & DestLast + 1).Paste
    End If

Next i

End Sub

如果要在“未计划”宏之后运行“计划”，则：

Sub Planned()

Dim DataSht As Worksheet, DestSht As Worksheet

Set DataSht = Sheets("All Data")

RowCount = DataSht.Cells(Cells.Rows.count, "A").End(xlUp).Row

For i = 2 to RowCount
        DataSht.Range("A" & i).EntireRow.Copy
        Set DestSht = Sheets(DataSht.Range("A" & i).Value)
          'You might want some error handling here for if the Sheet doesn't exist!
        DestLast = DestSht.Cells(Cells.Rows.count, "a").End(xlUp).Row
        DestSht.Range("a" & DestLast + 1).Paste
Next i

End Sub

Answer 2

此版本忽略M列，而使用A列：

Sub Not_Planned()

Sheets("All Data").Select

RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row

For i = 1 To RowCount
    DestinationSheet = Range("A" & i).Value

        ActiveCell.EntireRow.Copy
        Sheets(DestinationSheet).Select
        RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("All Data").Select
        Range("A2").Select

Next

End Sub