need to move data to another worksheet

[Jerk24]

I have a Sheet called Master... which is a report with 9 task. is there a way to move each task to another sheet that is named for that task... the names are shortened to the two Words because of size restrictions.

the task name is in D:D (the lengh of the report is longer some weeks)
i need the whole row to copy over

any ideas?

 

[mumps]

Hi Jerk24. Try this macro. It will copy the rows and not delete them from your "Master" sheet. If you want to delete them from the "Master", add this line:

rng.EntireRow.Delete

below this line:

 rng.EntireRow.Copy Sheets(ws.Name).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0

)

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim bottomD As Integer
    bottomD = Range("D" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each rng In Range("D2:D" & bottomD)
        For Each ws In Sheets
            If rng = ws.Name Then
                rng.EntireRow.Copy Sheets(ws.Name).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        Next ws
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Jerk24]

Getting a Object required error.

not sure what the cause is... and I did add that line-- since ideally if it is copied over (or cut in this instance) what is left I will need to look at.

 

[mumps]

Which line is being highlighted?

 

[Jerk24]

It is just a text box that tells me the error. but when i open VBA (or step-into the macro) Sub CopyRows() is highlighted

is there something that should tell the code to look for only the first part of the task name?

 

[mumps]

As it is, the code assumes that the task name is exactly the same as the corresponding sheet name. If the sheet name corresponds to only the first part of the task name, then the macro won't work. If this is the case, try this macro:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim bottomD As Integer
    bottomD = Range("D" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each rng In Range("D2:D" & bottomD)
        For Each ws In Sheets
            If rng Like "*" & ws.Name & "*" Then
                rng.EntireRow.Copy Sheets(ws.Name).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                rng.EntireRow.Delete
            End If
        Next ws
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Jerk24]

Ok. that is the case i implmended the new code and still getting the same error. it will pull a name or two, and put it in the right sheet. but that is all.

 

[mumps]

You have to make sure that all the necessary sheets matching the task name actually exist. The only other thing I can suggest is that you upload your file to a free site such as www.box.com where you can get a link to your file and then post the link here. If we can see the actual file, it would be easier to help.

 

[Jerk24]

I had trouble with loading things before. I checked all of the Tabs and all are labelled correctly- What if the code told it to read the first two words of the cell, then match with sheet name?

I will be away from my computer until Friday morning. Thank you for your help already. and have a happy thanksgiving.

 

[Jerry Sullivan]

Hi all,

I believe one problem is the For Each rng ...Next rng loop is not expecting objects to be deleted from the collection.
Workarounds include Stepping Up from row= bottomD to 2
or deleting the rows in one step after the loop is complete -perhaps delete the value in D, then delete rows with blanks in D using SpecialCells(xlCellTypeBlanks)

@Jerk24, are the Sheet Names on the Tabs consistently exact matches for the first two "words" in rng? If so, that would allow exact matching instead of stepping through all sheets to find Like matches.