Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: how to copy data between sheets selectively

  1. #1
    New Member
    Join Date
    Apr 2002
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)


    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 ]

  2. #2
    MrExcel MVP Damon Ostrander's Avatar
    Join Date
    Feb 2002
    Denver, Colorado USA
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)


    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
    End Function
    Keep Excelling.


    VBAexpert Excel Consulting
    LinkedIn Profile
    AllExperts Profile

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts