ディレクトリを経由するループエラー

Question

誰かが助けてくれることを願っています...私は一日中絶対的な治療を受けた以下のコードを持っています。 16時10分まで、そして今すぐsuddentlyランタイムエラーをピックアップすることにします。オンライン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 

誰でも助けてください。なぜこれが働いていたのか、私は非常に混乱しています。何も変わっておらず、いくつかのテストの後で今停止しました。

Answer 1

コメントに指摘されているように、行が不足しています。一つの解決策は、あなただけの最後の行をヒットしてきたかどうかをテストし、新しいワークシートを続ける（明らかにテストされていないが、あなたの要点を与える必要があります）することです：

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