复制单元格与工作表名称匹配的行会使下标超出范围（错误9）

Question

我在这个论坛上搜索了很长时间，并且学到了很多东西。 但是，我想我现在有一个容易解决的问题，但是我太盲目了，看不到正确的解决方案。

我有一个超过5万行的工作表，其中还包含一个供供应商使用的数字，因此这些数字恰好是重复的。 我有一个vba宏，它为每个供应商编号创建了一个新表，没有重复，所以那不是问题。 但是，我想将该行的数据复制到工作表中，该工作表等于该行中出现的供应商编号。

供应商编号在A列中。因此，如果第2行的供应商编号为10，则将该行复制到工作表“ 10”，第3行的编号为14到工作表“ 14”，第4行的编号为10再次工作表“ 10”，以此类推。

我使用了在这里找到的以下代码，并对它进行了一些重塑。

Sub CopyRows()

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)
DestLast = DestSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row
DestSht.Range("A" & DestLast + 1).Paste

Next i

End Sub

但是，它在此行上得到下标超出范围的错误：Set DestSht = Sheets（DataSht.Range（“ A”＆i）.Value）

Answer 1

尝试这个：

For i = 2 To RowCount      
    Set DestSht = Sheets(CStr(DataSht.Range("A" & i)))
    DestLast = DestSht.Cells(Cells.Rows.Count, "A").End(xlUp).row
    DataSht.Range("A" & i).EntireRow.Copy Destination:=DestSht.Range("A" & DestLast + 1)
Next I

以来：

• 使用CStr函数，它指向Sheets("12")

• 而Cstr则指向Sheets(12) ，即工作簿中的第十二个工作表，它可能不是您想要的工作表，也可能不存在。

Answer 2

导致此错误的原因是Excel无法识别与列A值同名的工作表。 您可能想运行这个小子，看看它是否为您提供了一个有关为什么的线索...

Sub SheetNamesAndIndexes()

DIm ws as Worksheet
For Each ws in ThisWorkbook.Sheets
    Debug.print ws.Name & ";" & ws.Index
Next
End Sub

这将显示所有工作表的名称和索引。 如果仍然不能解决问题，您可以将其合并到代码中以帮助您调试，就像这样...

Dim ws as Worksheet
For i = 2 To RowCount
    For Each ws in ThisWorkbook.Sheets
        Debug.Print ws.Name * ";""" & DataSht.Range("A" & i).Value & """;" & ws.Name = DataSht.Range("A" & i).Value
    Next
...

这会将Col A中每个单元格的值放在每个工作表名称的旁边，以及Excel是否认为这两个匹配。 如果您看到一个期望为“ True”的错误消息，请接下来进行调查。 我在DataSht.Range.Value周围加上了引号，以使其在出现多余空格等情况时更加明显。如果未产生答案，则建议使用另一个答案来确保您未将字符串与整数进行比较。 如果是这种情况，则将Range.Value包装在Cstr() ，然后再次运行。 祝好运！