I want to apply a loop on working code so it will

Question

I have code for copying some data rows from one worksheet to another. To copy I have repeatedly to click. A single click runs the code only once. So I tried Do While but that throws an Automation error during debugging on setting the rng. whole code is working fine....just want to add a run the same upto Do While Not IsEmpty(Range("A2")).

code:

Do While Not IsEmpty(Range("A2"))

Application.ScreenUpdating = False

    Set WSheet = ThisWorkbook.Worksheets("InputWbLocation")
    Set wbLocationPath = WSheet.Range("A2")
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    While wbLocationPath.Value <> ""
        If IsWorkBookOpen(wbLocationPath.Value) Then
            For Each wks In Workbooks
                If (wks.Path & "\" & wks.Name) = wbLocationPath Then
                    Set wb = wks
                    Exit For
                End If
            Next wks

        Else
            Set wb = Application.Workbooks.Open(wbLocationPath.Value, ReadOnly:=False, UpdateLinks:=0)
        End If

        For Each tmpSheet In wb.Worksheets

        If tmpSheet.Visible = xlSheetVisible Then
        If tmpSheet.Name <> "Supplier Instructions" Then

            lastrow = tmpSheet.Cells(tmpSheet.Rows.Count, "A").End(xlUp).Row
            If lastrow <> 1 And lastrow <> tmpSheet.Rows.Count Then

            Set Foundcell = tmpSheet.Range("A2:A" & lastrow).Find(What:="To be Uploaded")

            If Foundcell Is Nothing Then
            Set Foundcell = tmpSheet.Range("A2:A" & lastrow).Find(What:="To be loaded")
            Set Foundcell = tmpSheet.Range("A2:A" & lastrow).Find(What:="To  be Uploaded")
            End If
            Set Foundcell2 = tmpSheet.Range("A2:A" & lastrow).Find(What:="Completed")



            Do Until Foundcell Is Nothing
                'copy paste entire row on Autoload sheet
                Set rng = Range(tmpSheet.Cells(1, 1), tmpSheet.Cells(lastrow, 1))
                Foundcell.EntireRow.Copy
                If (Foundcell.Offset(0, 2).Value = "" Or Foundcell.Offset(0, 6).Value = "" Or Foundcell.Offset(0, 15).Value = "") Then
                    Set pasteSheet = Sheet6
                    resultMessage = "Error"
                Else
                    If InStr(wb.Name, "xlsx") <> 0 Or InStr(wb.Name, "xlsm") <> 0 Then
                        Set pasteSheet = Sheet5
                        resultMessage = "Completed"
                    Else
                        If InStr(tmpSheet.Name, "Ana") <> 0 Then
                            Set pasteSheet = Sheet3
                            resultMessage = "Completed"
                        Else
                            Set pasteSheet = Sheet1
                            resultMessage = "Completed"
                        End If
                    End If
                End If
                RowCount = WorksheetFunction.CountA(pasteSheet.Range("A:A")) + 1

                For Each c In rng.Cells
                If LCase(Trim(c)) = "to be uploaded" Or LCase(Trim(c)) = "to be loaded" Or LCase(Trim(c)) = "to  be uploaded" Then
                c.EntireRow.Copy
                pasteSheet.Cells(pasteSheet.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
                ActiveWorkbook.Saved = True
                Application.DisplayAlerts = False
                Application.EnableEvents = False

                End If
                Next c
               ActiveWorkbook.Close
               WSheet.Rows(2).Delete

            Loop



            Do Until Foundcell2 Is Nothing
            Set rng = Range(tmpSheet.Cells(1, 1), tmpSheet.Cells(lastrow, 1))
                'copy paste entire row on Autoload sheet
                Foundcell2.EntireRow.Copy
                If (Foundcell2.Offset(0, 2).Value = "" Or Foundcell2.Offset(0, 6).Value = "" Or Foundcell2.Offset(0, 15).Value = "") Then
                    Set pasteSheet = Sheet6
                    resultMessage = "Error"
                Else
                    If InStr(wb.Name, "xlsx") <> 0 Or InStr(wb.Name, "xlsm") <> 0 Then
                        Set pasteSheet = Sheet5
                        resultMessage = "Completed"
                    Else
                        If InStr(tmpSheet.Name, "Ana") <> 0 Then
                            Set pasteSheet = Sheet3
                            resultMessage = "Completed"
                        Else
                            Set pasteSheet = Sheet1
                            resultMessage = "Completed"
                        End If
                    End If
                End If
                RowCount = WorksheetFunction.CountA(pasteSheet.Range("A:A")) + 1

                For Each c In rng.Cells
                If LCase(Trim(c)) = "completed" Then
                c.EntireRow.Copy
                pasteSheet.Cells(pasteSheet.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
                ActiveWorkbook.Saved = True
                Application.DisplayAlerts = False
                Application.EnableEvents = False

                End If
                Next c
                ActiveWorkbook.Close
                WSheet.Rows(2).Delete
         Loop

            End If
            End If
            End If

            Next tmpSheet

        wb.Close SaveChanges:=True
        Set wbLocationPath = wbLocationPath.Offset(1, 0)
    Wend


errHandler:
'Resume

Loop
End Sub

After

Set `rng=...` 

It throw error - Automation error

Answer 1

The problem here is that Range() is Worksheet specific, meaning that it tries to retrieve a Range of the currently active worksheet - which is your evaluation sheet, I guess. This doesn't match with tmpSheet.Cells().

To fix this, simply use tmpSheet.Range(...) as you're doing in:

Set Foundcell = tmpSheet.Range("A2:A" & lastrow).Find(What:="To be Uploaded")

Answer 2

Problem was that I was trying to set rng after closing the wb inside the loop. So it's throwing the error because when the control was trying to set rng it was not getting the tmpSheet then it throw . So the code of Closing the sheet should be out of the loop.