Transferring Cell Values Between Worksheets | Str Looper

Question

Intended Result

• If a row in a table contains any of the listed strings in column L on Sheet1, Then copy the entire row from Sheet1 and paste the row into a duplicate table on Sheet2 (which would be blank at the beginning). (UNINTERESTED, UNRELATED, UNDECIDED, etc...)
• Then delete the entire row that was transferred from sheet 1.
• After macro runs, the new transfers should not reset table on Sheet2, rather add rows on the pre-existing lines. This document would be utilized over months.

Variables

• Sheet1 is named Pipeline_Input
• Sheet2 is named Closed_Sheet
• Sheet1 table is named tblData
• Sheet2 table is named tblClosed

Images

• Image 1 is the code with error
• Image 2 is Sheet 1 with some picture explanation
• Image 3 is Sheet 2 with some picture explanation

Current Result Run-time error '1004': Application-defined or object-defined error

Sub closedsheet()

Application.ScreenUpdating = False

    Dim Pipeline_input As Worksheet 'where is the data copied from
    Dim Closed_Sheet As Worksheet 'where is the data pasted to
    Dim strPhase() As String
    Dim i As Integer
    Dim intPhaseMax As Integer
    Dim lngLstRow As Long
    Dim rngCell As Range
    Dim finalrow As Integer
    Dim lr As Long 'row counter
    Dim Looper As Integer

    intPhaseMax = 6
    ReDim strPhase(1 To intPhaseMax)

    strPhase(1) = "LOST"
    strPhase(2) = "BAD"
    strPhase(3) = "UNINTERESTED"
    strPhase(4) = "UNRELATED"
    strPhase(5) = "UNDECIDED"
    strPhase(6) = "BUDGET"

    'set variables
    Set Pipeline_input = Sheet1
    Set Closed_Sheet = Sheet2

lr = Range("A" & Rows.Count).End(xlUp).Row

For Looper = LBound(strPhase) To UBound(strPhase)

    For i = lr To 6 Step -1
    Next
        If Not Sheet1.Range("L9:L300" & lngLstRow).Find(strPhase(Looper), lookat:=xlWhole) Is Nothing Then
        Range(Cells(i, 1), Cells(i, 20)).Copy
        Sheet2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        Range(Cells(i, 1), Cells(i, 20)).Delete
    End If
Next

Sheet2.Select
Sheet2.columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Answer 1

Okay, there were a plethora of issues with the code you posted, but I decided to help you out here - Notice a few things - There's no copying and pasting here - we're just transferring data.

Secondly, use easy to understand variables. lr and lngLastRow can't be distinguished from one another, so classify them by which worksheet you're getting that value from.

We create an array in one fell swoop here - Just declare a variant and place our values in. ARRAYS (TYPICALLY) START AT ZERO, NOT ONE, so our loop starts at 0 :). Again, this is what's known as best practice...

I swapped out Looper for j. Again, keep. it. simple!

EDIT: I tested this code out on a simulated workbook and it worked fine - should run into no issues for you either.

EDIT2: Also, always use Option Explicit!

Option Explicit
Sub closedsheet()
Application.ScreenUpdating = False

Dim Pipeline_Input As Worksheet 'source sheet
Dim Closed_Sheet As Worksheet 'destination sheet

Dim i As Long, j As Long, CSlastrow As Long, PIlastrow As Long

Dim strPhase As Variant

'Here we create our array
strPhase = Array("LOST", "BAD", "UNINTERESTED", "UNRELATED", "UNDECIDED", "BUDGET")

'Assign worksheets
Set Pipeline_Input = ActiveWorkbook.Worksheets("Pipeline_Input")
Set Closed_Sheet = ActiveWorkbook.Worksheets("Closed_Sheet")

PIlastrow = Pipeline_Input.Range("A" & Rows.Count).End(xlUp).Row

For j = 0 To UBound(strPhase)
    For i = PIlastrow To 6 Step -1
        If Pipeline_Input.Range("L" & i).Value = strPhase(j) Then

            'Refresh lastrow value
            CSlastrow = Closed_Sheet.Range("A" & Rows.Count).End(xlUp).Row

            'Transfer data
            Closed_Sheet.Range("A" & CSlastrow + 1 & ":S" & CSlastrow + 1).Value = _
            Pipeline_Input.Range("A" & i & ":S" & i).Value

            'Delete the line
            Pipeline_Input.Range("A" & i & ":S" & i).EntireRow.Delete

        End If
    Next i
Next j

Closed_Sheet.Select
Closed_Sheet.Columns.AutoFit
Application.ScreenUpdating = True
End Sub