how to copy data between sheets selectively

[arunpr]

I have got Sheet called Team with some data like given below.


Name Team
---- -----
Marc Team1
Stacy Team2
walt Team1


Based on their names I want to to copy them to Team1 sheet and Team2 sheet.
ie IF name==marc copy him in to Team1 sheet
How do i do this using a macro

[ This Message was edited by: arunpr on 2002-04-19 12:59 ]

[ This Message was edited by: arunpr on 2002-04-19 13:03 ]

[Damon Ostrander]

Hi Arunpr,

Here is a macro that I think you might find useful for doing this. Note that it also includes a helper function. In your example, just select the second column of your worksheet and run the macro. The macro will look in that column for names of worksheets, and when it finds a sheet will copy that row to the first available row on the destination sheet. This code should be placed in a macro module (Ctrl-TMV and paste in code window).


Sub CopyRowsToSheets()

'Copies all rows from the active worksheet to worksheets named in
'the selected column. For example, if column C is selected, and cell
'C2 contains a value "Team 1", then row 2 will be copied to worksheet
'named Team 1, if it exists (otherwise will ignore row). If a range
'of cells is selected (rather than a column) then this macro will just
'look for the worksheet names in the first column of that range, and
'copy only rows within the selected range of rows in this column.

Dim Cell As Range
Dim EndCell As Range
Dim rowCount As Long

rowCount = 0

Set EndCell = Cells(Selection.Row + Selection.Rows.Count - 1, Selection.Column)
If IsEmpty(EndCell) Then Set EndCell = EndCell.End(xlUp)

For Each Cell In Range(Selection.Cells(1), EndCell)
If SheetExists(Cell.Value) Then
With Worksheets(Cell.Value)
Rows(Cell.Row).Copy Destination:=.Rows(.UsedRange.Row + .UsedRange.Rows.Count)
rowCount = rowCount + 1
End With
End If

Next Cell

MsgBox rowCount & " rows copied", vbInformation, _
"Copy Rows to Sheets Results"

End Sub

Function SheetExists(SheetName As String) As Boolean
'Checks if sheet exists in active workbook
SheetExists = False
Dim Sh As Object
On Error GoTo NoSuch
If SheetName <> "" Then
Set Sh = Sheets(SheetName)
SheetExists = True
End If
NoSuch:
End Function