based on Cell/Column content ,cut one sheet's values and paste it in other sheet?

[mindpeace]

Dear All,
This is the problem haunting me for long time , i am very expert in VBA
.. hope some will give me solution

Have workbook with call status , with 15 columns 11th column give the
status of the sales call .

I want to create automated macro which will copy row data based on
status cell content to other sheet with same name as in status cell.
Suppose you have status “pending” in cell , it should cut that cell
and paste in worksheet named “pending” , same in pending sheet status
of complete row goes to complete sheet.

I have seen this working but I don’t remember the exact website.

Help will be well appreciated

 

[Nigel]

Here is some code you can adapt - the status cell (column 11) is used to
create a new worksheet(s) if they do not already exist and then copy the
entire row of data from the Data sheet to the next available space on the
target sheet. Column 16 is set to a 1 to indicate that the row has been
copied (otherwise it will copy again on the next run) This may not be what
you want, as changes etc., will never be copied. You could use a worksheet
level change event to reset column 16 as changes occur, but the original
copied row will persist in the target sheet. One other way would be to
erase all the target sheets first then re-copy again. Let me know how you
want to proceed and the code can be adapted as required.


Sub MoveStatus()

Dim LastDataRow As Long, xRow As Long
Dim TargetNextRow As Long, i As Integer, wsExists As Boolean
Dim SourceWS As Worksheet, TargetWS As Worksheet

Set SourceWS = Sheets("Data")

With SourceWS
' get last data row on the source sheet use column 11 (status)
LastDataRow = .Cells(Rows.Count, 11).End(xlUp).Row

' scan source from row 2 to end
For xRow = 2 To LastDataRow

' check if the status exists and row has not already been copied
If Len(Trim(.Cells(xRow, 11))) > 0 And .Cells(xRow, 16) < 1 Then
' check if the status sheet by name exists
wsExists = False
For i = 1 To Sheets.Count
If Sheets(i).Name = .Cells(xRow, 11).Text Then
wsExists = True
Exit For
End If
Next i
If Not wsExists Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = .Cells(xRow, 11).Text
End If
Set TargetWS = Sheets(.Cells(xRow, 11).Text)
' get location in target then copy data row
With TargetWS
TargetNextRow = .Cells(Rows.Count, 11).End(xlUp).Row
' if the first row then copy headings from source
If TargetNextRow = 1 Then
SourceWS.Rows(1).Copy Destination:=.Rows(1)
End If
End With
' copy the data and record in source as copied
TargetNextRow = TargetNextRow + 1
.Rows(xRow).Copy Destination:=TargetWS.Rows(TargetNextRow)
.Cells(xRow, 16) = 1
End If
Next xRow
End With

End Sub

 

[Tom Ogilvy]

http://www.rondebruin.nl/copy5.htm

 

[mindpeace]

thanks dear

let me check....
thanks again

http://www.rondebruin.nl/copy5.htm