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

我有以下代码将行移动到特定的工作表，其中列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中的值等于工作表名称？

请注意：我已经有了一个代码来创build工作表，并按照A列中的唯一值对其进行命名。

谢谢

Answer 1

编辑…显然你可以使用RowCount两次，并改变它的中间循环 。 由于variables来源于两张不同的纸张，因此不是很好的做法，但技术上可行。

首先停止使用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 

如果你想在你的“未规划”macros之后运行“计划”，那么：

 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