Macro - copying data between sheets

[lembi2001]

Hi All


I have registered because I need your help with a VBA Macro I have found online. I'm not great with VBA (read complete novice) and can just about understand the code however I am having a major issue with it.


Background:


I have a Workbook that wil be used to pull some data in from another workbook (this works as intended), this data is then to be parsed through and split into seperate sheets based on the value displayed in Column G.


The code I have works to a degree and works well however it stops after 7 runs and complains that the spreadsheet name is already taken.


This shouldn't happen and it doesn't happen on another sheet where multiple lines are copied to it.


In an effort to debug the code I have added a MsgBox to it to display the current sheet name, this works again as expected however the issue occurs when it hits a particular line in the sheet.

This is the Macro Code I have:

Sub copy_rows_to_sheets2()
        ' You must Dimensionalize each variable individually.
        Dim firstrow As Byte, lastrow As Long, r As Long, torow As Long
        Dim fromsheet As Worksheet, tosheet As Worksheet
        Set fromsheet = Worksheets("Imported")
        firstrow = 2
        lastrow = fromsheet.Cells(Rows.Count, "G").End(xlUp).Row
        On Error GoTo Errorcatch
        For r = firstrow To lastrow
            If fromsheet.Cells(r, "G") <> "" Then 'skip rows where column G is empty
                ' Check if the sheet exists with an external function.
                If Sheet_Exists(fromsheet.Cells(r, "G").Text) Then
                    ' If the sheet exsits set it as your tosheet.
                    Set tosheet = Worksheets(fromsheet.Cells(r, "G").Text) ' < Specify the cell Text as the new sheet name.
                Else ' If the sheet doesn't exists, add it.
                    Set tosheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    tosheet.Name = fromsheet.Cells(r, "G")
                End If
                MsgBox ("Sheet Name - " + tosheet.Name)
                torow = tosheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                fromsheet.Cells(r, 1).EntireRow.Copy
                tosheet.Cells(torow, 1).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
            End If
            fromsheet.Select
        Next r
Errorcatch:
MsgBox Err.Description
    End Sub

Column G contains the following values:

[TABLE="width: 64"]
<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64, bgcolor: #FFE699"]3015[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]3953[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]0007[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]3953[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]0812[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]1019[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]0007[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]3015[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]1201[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]1202[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]3950[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]3604[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]1007[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]3941[/TD]
[/TR]
[TR]
[TD="bgcolor: #FFE699"]3616
[/TD]
[/TR]
</tbody>[/TABLE]
<strike></strike>
The macro creates 5 new sheets, labelled 3015, 3953, 7, 812 and 1019, once it iterates as far as 1019 it crashes out on the next one which should be 7.

anyone able to shed any light as to why this is happening? Note that I don't have this issue on 3953.

Thanks

 

[Fluff]

Hi & welcome to MrExcel.
Try thsi mod

Set tosheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
tosheet.Name = fromsheet.Cells(r, "G")[COLOR=#ff0000].Text[/COLOR]

 

[lembi2001]

LEGEND!

Thank you, can't believe it was something so stupidly simple

 

[Fluff]

Glad to help & thanks for the feedback