循环错误通过目录

Question

I am hoping someone can help... I have the below code which worked an absolute treat all day. Until 16:10 and now suddently decides to pick up a runtime error. on line Sheet1.Cells(lastRow, 1) = Data

Sub Loopthroughtxtdir()
    Dim Filename As String
    Dim Path As String

    Path = "C:\MK\MasterData\"
    Filename = Dir(Path & "*.txt")

    With ThisWorkbook.Sheets("Sheet1")
        Dim lastRow As Long
        lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Do While Len(Filename) > 0
            Dim handle As Integer
            handle = FreeFile
            Open Path & Filename For Input As #handle
            Do Until EOF(handle)
                Line Input #handle, Data
                Sheet1.Cells(lastRow, 1) = Data
                lastRow = lastRow + 1
            Loop
            Close #handle
            Filename = Dir
        Loop
    End With

    MsgBox ("Import Complete")

End Sub

Can anyone please assist. I am very confused why this was working. Nothing has changed and now has stopped after several tests.

Answer 1

As pointed out in the comments, you're running out of rows. One solution would be to test to see if you've just hit the last row, and then continue on a new worksheet (obviously untested, but should give you the gist):

Sub Loopthroughtxtdir()
    Dim Filename As String
    Dim Path As String

    Path = "C:\MK\MasterData\"
    Filename = Dir$(Path & "*.txt")

    Dim currentSheet As Worksheet
    Set currentSheet = ThisWorkbook.Worksheets("Sheet1")
    With currentSheet
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    End With

    Do While Len(Filename) > 0
        Dim handle As Integer
        handle = FreeFile
        Open Path & Filename For Input As #handle
        Do Until EOF(handle)
            Line Input #handle, Data
            currentSheet.Cells(lastRow, 1) = Data
            lastRow = lastRow + 1
            If lastRow > currentSheet.Rows.Count Then
                Set currentSheet = ThisWorkbook.Worksheets.Add
                lastRow = 1
            End If
        Loop
        Close #handle
        Filename = Dir$
    Loop

    MsgBox ("Import Complete")
End Sub