Page 1 of 2 12 LastLast
Results 1 to 10 of 17

Thread: If cell value = something, then cut row and paste to next sheet
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jul 2019
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default If cell value = something, then cut row and paste to next sheet

    Good afternoon and thank you for any help or advise.

    I am trying to look through a dynamic range in column B and, where the column B value has a 2nd character = "E", then cut that entire row and paste it on to the next sheet.
    There will be many times that column B will match my criteria, so the second worksheet's range will grow as more rows are removed from the first worksheet and pasted on to the 2nd one.

    The value in B will look like: 6B230L, 5E431U, 6E226L, 6D537L...

    In this example, I would need to cut the row with 5E431U and the row with 6E226L and paste them on to worksheet 2 and then continue looking through column B, doing the same type of thing, until I reach the bottom of the sheet.

    I have seen may other macros that ALMOST do what I need, but the one that came closest didn't delete the blank row from the first sheet. It didn't actually cut the row, it just moved the data, I think.

    -Christine

  2. #2
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,403
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    How about this. It assumes that your main sheet is sheet1 and the sheet to be copied to is sheet2.

    Code:
    Sub MXL201907201()
    Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
    Dim AR() As Variant: AR = ws1.UsedRange
    Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
    Dim DA As Object: Set DA = CreateObject("System.Collections.ArrayList")
    
    
    For i = LBound(AR) + 1 To UBound(AR)
        If Mid(AR(i, 2), 2, 1) = "E" Then
            AL.Add Application.Index(AR, i, 0)
            DA.Add i
        End If
    Next i
    
    
    ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(AL.Count, UBound(Application.Transpose(AL.toarray), 1)).Value = Application.Transpose(Application.Transpose(AL.toarray))
    
    
    For j = DA.Count - 1 To 0 Step -1
        ws1.Rows(DA(j)).Delete
    Next j
    
    
    End Sub
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  3. #3
    New Member
    Join Date
    Jul 2019
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    Thank you for taking the time to help. I really appreciate it.
    When I run the code, I get a run-time error. Automation error and the debug shows this line in yellow: Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")

  4. #4
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,403
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    ***Posted wrong code
    Last edited by lrobbo314; Jul 20th, 2019 at 11:21 PM.
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  5. #5
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,403
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    Ok, give this a shot.

    Code:
    Sub MXL201907201()
    Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
    Dim AR() As Variant: AR = ws1.UsedRange
    Dim cnt As Long: cnt = 0
    Dim AL() As Variant
    Dim DA() As Variant
    
    For i = LBound(AR) + 1 To UBound(AR)
        If Mid(AR(i, 2), 2, 1) = "E" Then
            ReDim Preserve AL(0 To cnt)
            ReDim Preserve DA(0 To cnt)
            AL(cnt) = Application.Index(AR, i, 0)
            DA(cnt) = i
            cnt = cnt + 1
        End If
    Next i
    
    ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(AL) + 1, UBound(AL()(0), 1)).Value = Application.Transpose(Application.Transpose(AL))
    
    For j = UBound(DA) To 0 Step -1
        ws1.Rows(DA(j)).Delete
    Next j
    
    End Sub
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  6. #6
    New Member
    Join Date
    Jul 2019
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    Again, thank you for taking the time to help me.

    I'm getting a run-time error again, but it's now happening at this line:

    ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(AL) + 1, UBound(AL()(0), 1)).Value = Application.Transpose(Application.Transpose(AL))

    It is a run-time error 5; Invalid procedure call or argument.

  7. #7
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,403
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    Not sure why you are getting those errors. Both codes work fine on my test data. What version of Excel are you using?

    Try this.

    Code:
    Sub MXL201907203()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
    Dim AR() As Variant: AR = ws1.UsedRange
    Dim cnt As Long: cnt = 0
    Dim AL() As Variant
    Dim LR As Long: LR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For i = UBound(AR) To 1 Step -1
        If Mid(AR(i, 2), 2, 1) = "E" Then
            ReDim Preserve AL(0 To cnt)
            AL(cnt) = Application.Index(AR, i, 0)
            ws1.Rows(i).Delete
            cnt = cnt + 1
        End If
    Next i
    
    For j = 0 To UBound(AL)
        For k = 1 To UBound(AL()(0), 1)
            ws2.Cells(LR, k) = AL()(j)(k)
        Next k
        LR = LR + 1
    Next j
    
    Application.ScreenUpdating = True
    End Sub
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  8. #8
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,213
    Post Thanks / Like
    Mentioned
    471 Post(s)
    Tagged
    47 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    How about
    Code:
    Sub Rackette()
       With Sheets("Sheet1")
          .Range("A1").AutoFilter 2, "?E*"
          .AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
          .AutoFilter.Range.Offset(1).EntireRow.Delete
          .AutoFilterMode = False
       End With
    End Sub
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  9. #9
    New Member
    Join Date
    Jul 2019
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    Hmmm...if these work for both of you, then I'm going to assume that I'm the one doing something wrong. I'm using Office 365.
    Fluff, I don't get any errors with your code, but it doesn't seem to do anything to my data. It runs, but nothing gets cut or pasted or changed in any way that I can see. Certainly nothing is being pasted to the second sheet.
    Irobbo, I'm getting another run-time error 9, Subscript out of range with your most recent code at this line: For j = 0 To UBound(AL)
    I am saving these in my Personal macro workbook. Is that what I'm supposed to be doing?

  10. #10
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,213
    Post Thanks / Like
    Mentioned
    471 Post(s)
    Tagged
    47 Thread(s)

    Default Re: If cell value = something, then cut row and paste to next sheet

    Do you have a header in row 1 with data starting in A2?
    Also the workbook containing the data needs to be the active workbook, when running the code.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

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
  •