Question

我有以下代码将行移动到特定工作表，其中M列中的单元格值等于值：＆＃39; not planned＆＃39;

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

已编辑...显然是你CAN use RowCount twice and change it mid-loop。不是很好的做法，因为变量来自两个不同的表，但它在技术上将起作用。

首先关闭STOP USING 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

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

2 个答案: