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?

 

[Jerk24]

No the Tabs are consistent with the First two words, some times three... the Code seems to grab some of the iformation. I do not feel confident enough to alter the code as suggusted. I recorded a Macro. but the problem is that it is set to a certain cell number and not a overall grab, this will not work since the report that i copy will be different sizes.

 

[apo]

HI..
Can you provide more detail... perhaps a Workbook showing your Workbook structure and desired results.. uploaded to MEdiafire/dropbox (both have free accounts)..

That will make it far easier to help you..

 

[mumps]

The code I posted in Post #6 should find the task name whether it is one, two or three words as long as they are entered in exactly the same way in the sheet names. Please try to post your file as I suggested and apo suggested.

 

[Jerry Sullivan]

The code I posted in Post #6 should find the task name whether it is one, two or three words as long as they are entered in exactly the same way in the sheet names. Please try to post your file as I suggested and apo suggested.

mumps, Did you see my explanation of why the code in Post #6 might be generating an error?
The problem isn't necessarily a name mismatch. Even if the names are exact matches or like matches, deleting rows within the For Next block can create problems.

Here's some code that should work. If it doesn't work, a MsgBox will display the sheet name the code is trying to find for the Cell in Column D. That should help find any inconsistencies in the sheet naming.

Sub CopyRows2()
Dim c As Range, rBlanks As Range
Dim nRows As Long
Dim sWsName As String
Dim vWords As Variant

With ActiveSheet   
   nRows = .Cells(.Rows.Count, "D").End(xlUp).Row - 1
   If nRows < 1 Then Exit Sub
   Application.ScreenUpdating = False
   For Each c In .Range("D2").Resize(nRows)
      vWords = Split(c, " ")
      If UBound(vWords) Then
         sWsName = vWords(0) & " " & vWords(1)
      Else
         sWsName = c
      End If
      
      If SheetExists(sWsName) Then
         c.EntireRow.Copy Sheets(sWsName) _
            .Cells(Rows.Count, "A").End(xlUp).Offset(1)
         c.ClearContents '--mark row for deletion
      Else
         MsgBox c.Address & ": Sheet """ & _
            sWsName & """ not found"
      End If
   Next c
   
   Set rBlanks = .Range("D2").Resize(nRows) _
      .SpecialCells(xlCellTypeBlanks)
   If Not rBlanks Is Nothing Then _
         rBlanks.EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub

Private Function SheetExists(sName As String) As Boolean
    On Error Resume Next
    SheetExists = Sheets(sName).Index > 0
End Function

 

[mumps]

Hi Jerry. You are perfectly correct. Thank you for the reminder.

 

[Jerk24]

Thanks for all the Help Mumps - The code you emailed me works great. I was even able to change a tab name back to what it was before i sent it to you.JS441 - thank you also for your input. below is the code that works for me.

Sub CopyRows()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim x As Long
Dim y As Long
y = 2
Dim ws As Worksheet
For Each ws In Sheets
For x = LastRow To 2 Step -1
If Cells(x, "D") Like "*" & ws.Name & "*" Then
Rows(x).EntireRow.Copy Sheets(ws.Name).Cells(y, "A")
y = y + 1
Rows(x).EntireRow.Delete
End If
Next x
y = 2
Next ws
For Each ws In Sheets
If ws.Name <> "Master" Then
ws.Activate
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("A2:F" & LastRow).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("E2:E" & LastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A2:F" & LastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Next ws
Application.ScreenUpdating = True
End Sub

 

[mumps]

My pleasure.