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

Question

I was searching around this forum for quite a long time and learned quite a bit. However, I have a problem now which is easy to fix, I guess, but I am too blind to see the right solution.

I have a sheet with over 50k rows which also contain a number for suppliers, so these numbers happen to be duplicates. I got a vba macro which creates a new sheet for every supplier number without duplicates, so thats not the problem. However, I want to copy the data of the row to the worksheet which is equal to the supplier number appearing in that row.

The supplier numbers are in column A. So, if Row 2 has supplier number 10 then copy the row to sheet "10", Row 3 has number 14 to sheet "14", Row 4 has number 10 to sheet "10" again and so on.

I used the following code I found here and remodeld it a bit.

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

However it get an subscript out of range error on this line: Set DestSht = Sheets(DataSht.Range("A" & i).Value)

Answer 1

Try this:

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

Since:

• with CStr function it points to Sheets("12")

• while Cstr it'd point to Sheets(12) , ie the twelfth sheet in the workbook, which could not be the one you'd want or neither be there.

Answer 2

This error is caused because Excel can't identify a sheet with the same name as your column A value. You might want to run this small sub to see if it gives you a clue as to why...

Sub SheetNamesAndIndexes()

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

This will show you the names and the indexes of all your sheets. If that doesn't reveal the problem, you can take this and incorporate it into your code to help you debug, like so...

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
...

This will put the value of each cell in Col A next to each sheet name, along with whether or not Excel thought the two matched. If you see one that says "False" that you expect to be "True", investigate that next. I've put quotes around the DataSht.Range.Value to make it more obvious if you've got extra spaces, etc. If that doesn't yield answers, another answer suggested making sure that you're not comparing strings to integers. If that's the case, then wrap your Range.Value in a Cstr() and run it again. Good Luck!