Moving data from one sheet to multiple sheets - vba

[Eitel13]

Hi All,

I have some code that creates worksheets based on a cell value in a column and then I have the below code which will scan the same column and move the entire row of that sheet to the matching sheet name.

Sub CopyRowData()

'Declare variables
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim shSource As Worksheet
Dim shTarget1 As Worksheet
Dim shTarget2 As Worksheet
Dim shTarget3 As Worksheet
Dim shTarget4 As Worksheet
Dim shTarget5 As Worksheet
Dim shTarget6 As Worksheet

'Assign string values to variables
Set shSource = ThisWorkbook.Sheets("1")
Set shTarget1 = ThisWorkbook.Sheets("2")
Set shTarget2 = ThisWorkbook.Sheets("3")
Set shTarget3 = ThisWorkbook.Sheets("4")
Set shTarget4 = ThisWorkbook.Sheets("5")
Set shTarget5 = ThisWorkbook.Sheets("6")
Set shTarget6 = ThisWorkbook.Sheets("7")

'Locate the rows to be checked
'2
If shTarget1.Cells(3, 6).Value = "" Then
a = 3
Else
a = shTarget1.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'3
If shTarget2.Cells(3, 6).Value = "" Then
b = 3
Else
b = shTarget2.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'4
If shTarget3.Cells(3, 6).Value = "" Then
c = 3
Else
c = shTarget3.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'5
If shTarget4.Cells(3, 6).Value = "" Then
d = 3
Else
d = shTarget4.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'6
If shTarget5.Cells(3, 6).Value = "" Then
e = 3
Else
e = shTarget5.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'7
If shTarget6.Cells(3, 6).Value = "" Then
f = 3
Else
f = shTarget6.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If


i = 3

'Do while that will read the data of the cells in the 5th column and if it is match for the string variables, it will move the entire row to the worksheet of the same name
Do While i <= 200
    '2
    If Cells(i, 6).Value = "2" Then
    shSource.Rows(i).Copy
    shTarget1.Cells(a, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    a = a + 1
    GoTo Line1
    
    '3
    ElseIf Cells(i, 6).Value = "3" Then
    shSource.Rows(i).Copy
    shTarget2.Cells(b, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    b = b + 1
    GoTo Line1
    End If
    
    '4
    If Cells(i, 6).Value = "4" Then
    shSource.Rows(i).Copy
    shTarget3.Cells(c, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    c = c + 1
    GoTo Line1
    
    '5
    ElseIf Cells(i, 6).Value = "5" Then
    shSource.Rows(i).Copy
    shTarget4.Cells(d, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    d = d + 1
    GoTo Line1
    End If
    
    '6
    If Cells(i, 6).Value = "6" Then
    shSource.Rows(i).Copy
    shTarget5.Cells(e, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    e = e + 1
    GoTo Line1
    
    '7
    ElseIf Cells(i, 6).Value = "7" Then
    shSource.Rows(i).Copy
    shTarget6.Cells(f, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    f = f + 1
    GoTo Line1
    End If
    
    i = i + 1


Line1:     Loop

    Set mysheet = ActiveSheet
    Dim wrksht As Worksheet
    For Each wrksht In Worksheets
       
    wrksht.Select
    Cells.EntireColumn.AutoFit
       
    Next wrksht
    mysheet.Select

End Sub

I get the "Run Time Error 9, Subscript out of range". The reason I get this error is because the sheet does not exist.
So for example, when the sheets are being created based on their cell values and in the cell there's no actual number 4, then a sheet with the name "4" will obviously not be created. So the above code when executed throws out this error.

Ideally I wanted to code it in a way that didn't require hard coded string variables to do the check, but I simply don't know how to create that dynamic piece of code. So this is what I have at the moment and I am hoping someone can either help clean up the code to not have hard coded variables (1,2,3,4...) and perhaps just do a check first if the sheet exists then look for the sheet name in the column OR do the same thing but just input some kind of if statement to determine if the sheet exists before it bombs out.

I'm thinking of something like:

If (sheet.name("4") exists) Then
Set shTarget4 = ThisWorkbook.Sheets("4")
Else
Resume

 

[xwb]

Wrong forum - try

http://www.tek-tips.com/threadminder.cfm?pid=707

 

[SkipVought]

Hi,

I agree with xwb, forum707 is the forum to address Excel VBA.

However, why would you chop up your data into multiple sheets? A simple Auto Filter would accomplish the same effect.

I have been looking at your code and your problems are much worse than you think.

When you delete rows in your source data sheet, you are multiplying your problems, not only in your code, but also in your future ability to perform any kind of data analysis on your data.

Lets say that you're on row 3, (i = 3). You have copied row 3 data to the intended sheet/row and now you DELETE row 3 and increment i to 4.

But WAIT. when you deleted row 3, row 4 became row 3! AND you have begun to destroy your valuable source data.

AND it gets worse:

'Assign string values to variables
Set [highlight #FCE94F]shSource[/highlight] = ThisWorkbook.Sheets("[highlight #8AE234]1[/highlight]")

Your [highlight #FCE94F]SOURCE[/highlight] data sheet is also a [highlight #8AE234]TARGET[/highlight] sheet

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Eitel13]

My apologies for posting in the wrong place, I will open it int he correct place.

@Skip, there's no need for me to keep the original sheet's data as this is not the source sheet.
The data from the first sheet comes from its source via means of a macro, so if I ever need to refer to the source data then it wont be an issue.
Also, the other reason is that each sheet will be saved as individual workbooks in a folder when my macro's are run so that I can send off each individual sheet to their respective departments.

Thank you for the response