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

[Rackette]

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

 

[lrobbo314]

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

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

 

[Rackette]

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")

 

[lrobbo314]

***Posted wrong code

 

[lrobbo314]

Ok, give this a shot.

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

 

[Rackette]

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.

 

[lrobbo314]

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.

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

 

[Fluff]

How about

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

 

[Rackette]

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?

 

[Fluff]

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.