每个循环中错误1004的解决方案是什么?

Question

Sub create_category()
Dim cell As Range
Dim wsname As Worksheet
Dim test As Boolean
For Each cell In Sheets("Data").Range("d4", Range("d" & Rows.Count).End(xlUp))
test = False
For Each wsname In ThisWorkbook.Sheets
If wsname.name = cell Then test = True
Next wsname

If test = False Then Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.name = cell

Sheets(cell.name).Range("d3").End(xlDown).Offset(1, 0) = cell         
Next cell
Sheets("Data").Select
End Sub

我的代码应该创建额外的表，并根据单元格中的数据相应地复制数据。

程序执行代码没有问题，直到我在Next cell之前添加了一行代码，有趣的是，错误显示为第四行代码For Each cell IN Sheets("Data").Range.....。

你可以想象我很困惑，尤其是考虑到我是一个初学者。

指示错误为1004

我试着用不同的思维过程重写它的副本，但我以相同的结果结束。非常感谢你的帮助

Answer 1

当你写

Sheets("Data").Range("d4", Range("d" & Rows.Count).End(xlUp))

VBA将尝试在您的工作表"数据"上创建一个范围。区域的起点是单元格D4。对于Range的末尾，您写入Range("d" & Rows.Count).End(xlUp)，但您不告诉VBA要从哪个工作表访问此单元格。虽然这对你来说似乎是显而易见的，但它并不适用于VBA。它将从活动工作表中读取单元格，这将导致无效的范围定义，该范围定义为1004。

总是对于每个访问Range或Cells，指定您想要工作的工作表。

我建议使用中间变量使调试更容易。注意Range和Rows前面的点(.)。

Dim lastCell as Range, dataRange as Range
With ThisWorkbook.Sheets("Data")
Set lastCell = .Range("d" & .Rows.Count).End(xlUp)
Set dataRange = .Range("D4", lastCell)
End With
For Each cell in dataRange
...
Next cell

下面的代码也有问题。将循环改为

For Each cell In dataRange
Dim ws As Worksheet
Set ws = getWorksheet(cell.Value)
ws.Range("d3").End(xlDown).Offset(1, 0) = cell.Value
Next cell

并添加以下函数

Function getWorksheet(sheetname As String) As Worksheet
On Error Resume Next
Set getWorksheet = ThisWorkbook.Sheets(sheetname)
On Error GoTo 0
If getWorksheet Is Nothing Then
Set getWorksheet = ThisWorkbook.Worksheets.Add
getWorksheet.Name = sheetname
End If
End Function

但是我不确定逻辑:当前代码将把工作表的名称(cell.Value)写入工作表-我怀疑这是你想要的。