Need help stepping backward in a loop

[sdf1hkl]

It's been a long time since I've written macros and I guess I have gotten (extremely) rusty. I have a workbook with some data and I want to move all lines with a particular error code onto another worksheet called "Do Not Work"

I have 2 problems.
1) I have pieced together the below code and it only moves some of the lines with the error code. Prior to adding in the code to create a new worksheet if the macro was executed about 5 times everything would eventually move.I know it's a problem with the loop and needing to step backwards but I can't figure out how to implement in this code.

2) Right now my code is explicitly written to move data from "Sheet1". The reality is the sheet with the data that needs to be moved will always be called something different but will always be the 1st worksheet. Is there a way to address this?

Thanks for any help!

<code>Sub BillRunErr_27807()

Dim Newsheet
Set Newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
Newsheet.Name = "DO NOT WORK"

Application.ScreenUpdating = False

Sheets("Sheet1").Select
Rows("1:1").Select
Selection.Copy
Sheets("DO NOT WORK").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select

Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
i = Sheets("Sheet1").UsedRange.Rows.Count
J = Sheets("DO NOT WORK").UsedRange.Rows.Count

If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("DO NOT WORK").UsedRange) = 0 Then J = 0
End If

Set xRg = Worksheets("Sheet1").Range("A1:A" & i)
For Each xCell In xRg
If CStr(xCell.Value) Like "*YMM27807*" Then
xCell.EntireRow.Copy Destination:=Worksheets("DO NOT WORK").Range("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub </code>

 

[Eric W]

Try this on a copy of your workbook:

Sub BillRunErr_27807()
Dim NewSheet As Worksheet, CopyRange As Range, MyRange As Variant, i As Long

    Application.ScreenUpdating = False
        
    Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    NewSheet.Name = "DO NOT WORK"

    Sheets(1).Select
    Range("A1:F1").Copy NewSheet.Range("A1:F1")

    MyRange = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value

    For i = 2 To UBound(MyRange)
        If MyRange(i, 1) Like "*YMM27807*" Then
            If CopyRange Is Nothing Then
                Set CopyRange = Cells(i, 1)
            Else
                Set CopyRange = Union(CopyRange, Cells(i, 1))
            End If
        End If
    Next i

    CopyRange.EntireRow.Copy NewSheet.Rows(2)
    CopyRange.EntireRow.Delete
    
    Application.ScreenUpdating = True

End Sub

The line in red should select the first sheet. In the line below it, change the ranges to be the number of headings you want to copy.

Let me know how this works.

 

[sdf1hkl]

It doesn't like sheets(1).select

I get Run time error 1004: select method of worksheet class failed.

Any other ideas to address a changing worksheet name?
If I change the 1 to the actual sheet name it works wonderfully. Your solution is much more elegant than I was trying to do!

Try this on a copy of your workbook:

Sub BillRunErr_27807()
Dim NewSheet As Worksheet, CopyRange As Range, MyRange As Variant, i As Long

    Application.ScreenUpdating = False
        
    Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    NewSheet.Name = "DO NOT WORK"

    Sheets(1).Select
    Range("A1:F1").Copy NewSheet.Range("A1:F1")

    MyRange = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value

    For i = 2 To UBound(MyRange)
        If MyRange(i, 1) Like "*YMM27807*" Then
            If CopyRange Is Nothing Then
                Set CopyRange = Cells(i, 1)
            Else
                Set CopyRange = Union(CopyRange, Cells(i, 1))
            End If
        End If
    Next i

    CopyRange.EntireRow.Copy NewSheet.Rows(2)
    CopyRange.EntireRow.Delete
    
    Application.ScreenUpdating = True

End Sub

The line in red should select the first sheet. In the line below it, change the ranges to be the number of headings you want to copy.

Let me know how this works.

 

[Eric W]

I don't know what to tell you about the

    Sheets(1).Select

line. It should select the first sheet of the workbook. I haven't been able to duplicate your error. You could try

Worksheets(1).Select

or

    For Each sh In Worksheets
        Sheets(sh.Name).Select
        Exit For
    Next sh

but frankly, those probably won't work either. They might give you some information though. Let us know if you figure something out.