Results 1 to 5 of 5
  1. #1
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Illinois
    Posts
    552
    Thanks
    0
    Thanked 1 Time in 1 Post

    Search through rows and paste to another worksheet (Excel xp VBA)

    I have a range("I3:I" & lastrow) that i want to search through to find a 2 or a 4 in the first character.

    dim scell as range
    set sourcesheet = workbooks("main.xls").sheets("data")
    set sortsheet1 = workbooks("norm.xls").sheets("sort1")
    set sortsheet2 = workbooks("norm.xls").sheets("sort2")

    sourcesheet.select
    for each scell in range("I3:I" & lastrow)
    if LEFT(range(scell.value) = 2 or LEFT(range(scell.value)=4 then
    copy the columns C through J of that row to
    sortsheet1.select
    range("A25").select
    paste the row here
    go down 1 row

    next scell 'go back to sourcesheet and see if the next row has a 2 or a 4

    Then go through the sourcesheet again and look for a 1 or 3 in the first character and paste it to a sheet called sort2

    I don't know how to copy specific columns to another sheet. Thank you for the help. <img src=/S/compute.gif border=0 alt=compute width=40 height=20>

  2. #2
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Search through rows and paste to another worksheet (Excel xp VBA)

    See if this does what you want:

    <pre>Dim oSCell As Range, I As Long, J As Long, lLastRow As Long
    Dim oSourceSheet As Worksheet, oSortSheet1 As Worksheet, oSortSheet2 As Worksheet
    Application.ScreenUpdating = False
    Set oSourceSheet = Workbooks("main.xls").Sheets("data")
    Set oSortSheet1 = Workbooks("norm.xls").Sheets("sort1")
    Set oSortSheet2 = Workbooks("norm.xls").Sheets("sort2")
    I = 0
    J = 0
    With oSourceSheet
    lLastRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
    For Each oSCell In .Range("I3:I" & lLastRow)
    If (Left(oSCell.Value, 1) = 2) Or (Left(oSCell.Value, 1) = 4) Then
    Range(.Range("C1").Offset(oSCell.Row - 1, 0), .Range("J1").Offset(oSCell.Row - 1, 0)).Copy
    oSortSheet1.Paste Destination:=oSortSheet1.Range("A1").Offset(I, 0)
    I = I + 1
    End If
    If (Left(oSCell.Value, 1) = 1) Or (Left(oSCell.Value, 1) = 3) Then
    Range(.Range("C1").Offset(oSCell.Row - 1, 0), .Range("J1").Offset(oSCell.Row - 1, 0)).Copy
    oSortSheet2.Paste Destination:=oSortSheet2.Range("A1").Offset(J, 0)
    J = J + 1
    End If
    Next oSCell
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    </pre>

    Legare Coleman

  3. #3
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Weert, Limburg, Netherlands
    Posts
    4,812
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Search through rows and paste to another worksheet (Excel xp VBA)

    Untested:
    with sourcesheet
    for each scell in .range("I3:I" & lastrow)
    if (LEFT(range(scell.value),1) = 2) or (LEFT(range(scell.value),1)=4) then
    .Range(scell.offset(,-6),scell.offset(,1).copy Destination:=sortsheet.range("A65536").end(xlup).o ffset(1)
    End If
    next
    End with
    Jan Karel Pieterse
    Microsoft Excel MVP, WMVP
    www.jkp-ads.com
    Professional Office Developers Association

  4. #4
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Illinois
    Posts
    552
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Search through rows and paste to another worksheet (Excel xp VBA)

    thank you. Now i find that i have to paste noncontiguous columns. C, Q to AB and AD to AT.

    Range(.Range("C1").Offset(oSCell.Row - 1, 0), .Range("J1").Offset(oSCell.Row - 1, 0)).Copy

    I tried to modify this statement but couldn't make it work. Do i add to it or just change it? thanks for the help.

  5. #5
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,054
    Thanks
    2
    Thanked 417 Times in 346 Posts

    Re: Search through rows and paste to another worksheet (Excel xp VBA)

    Hi jha,

    To copy discontiguous ranges, you can wrap them with a UNION, like:
    Union(Range("C1").Offset(oSCell.Row - 1, 0), Range(.Range("Q1").Offset(oSCell.Row - 1, 0), .Range("AB1").Offset(oSCell.Row - 1, 0)), _
    Range(.Range("AD1").Offset(oSCell.Row - 1, 0), .Range("AT1").Offset(oSCell.Row - 1, 0))).Copy
    Note that the pasted result places the copied columns consecutively (ie it doesn't leave empty columns for the ones you didn't copy).

    Cheers
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

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