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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.