×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Moving data from one sheet to multiple sheets - vba

Moving data from one sheet to multiple sheets - vba

Moving data from one sheet to multiple sheets - vba

(OP)
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.

CODE --> VBA

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:

CODE --> VBA

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


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.

RE: Moving data from one sheet to multiple sheets - vba

Eitel13,
You may simple state what it is that you want to happen, and your code may get very, very short.

Something like:

For X = 1 To 6
    Filter Source Where Col F = X
    If records exist
        Create a new worksheet "Dept " & X
        Copy filtered rows from Source
        Paste rows into "Dept " & X worksheet
    End If
Next X
Delete Source
 


---- Andy

There is a great need for a sarcasm font.

RE: Moving data from one sheet to multiple sheets - vba

...and this type of Delete method will not give you the desired effect, since,
let’s say i = 2
You Delete row 2. Fine!
HOWEVER, what Was row 3, is now row 2! TILT!!! Your code will NEVER see row 3. Row 4 becomes row 3.

And so it goes.

In general, when deleting rows, start with the LAST row and incriment in reverse.

CODE

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

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Moving data from one sheet to multiple sheets - vba

Since sheet “1” is your source...

CODE

'Assign string values to variables
Set shSource = ThisWorkbook.Sheets("1") 
...Filter/Copy loop...
For X = 2 To 7
    Filter Source Where Col F = X
    If records exist
        Create a new worksheet "Dept " & X
        Copy filtered rows from Source
        Paste rows into "Dept " & X worksheet
    End If
Next X
Delete Source in “1” Filtering where col F > “1”
 

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close