Копирование определенных строк с одного .txt на другой *.txt

Option Explicit
 
Dim infile, outfile, i, fso, arg, extp
If WScript.Arguments.Count = 0 Then
  MsgBox "Использование:" & vbLf & _
    WScript.scriptname & " ИмяФайла1 ИмяФайла2 ..." & vbLf & _
    "или выделите один или несколько файлов в Проводнике и перетащите их на значок скрипта."
  WScript.Quit
End If
Set fso = CreateObject("scripting.filesystemobject")
For Each arg In Array("c:\temp\111.txt", "c:\temp\Копия 111.txt")
  Set infile = fso.opentextfile(arg)
  extp = InStrRev(arg, ".")
  Set outfile = fso.createtextfile(Left(arg, extp - 1) & "_1" & Mid(arg, extp))
  Do While Not infile.atendofstream
    Select Case LCase(infile.readline)
    Case "sender:", "receiver:"
      For i = 1 To 4
        If Not infile.atendofstream Then
          outfile.writeline infile.readline
        Else
          Exit Do
        End If
      Next
    End Select
  Loop
Next

Option Explicit
 
Dim infile, outfile, i, fso, arg, extp, s
If WScript.Arguments.Count = 0 Then
  MsgBox "Использование:" & vbLf & _
    WScript.scriptname & " ИмяФайла1 ИмяФайла2 ..." & vbLf & _
    "или выделите один или несколько файлов в Проводнике и перетащите их на значок скрипта."
  WScript.Quit
End If
Set fso = CreateObject("scripting.filesystemobject")
For Each arg In WScript.Arguments
  Set infile = fso.opentextfile(arg)
  extp = InStrRev(arg, ".")
  Set outfile = fso.createtextfile(Left(arg, extp - 1) & "_1" & Mid(arg, extp))
  Do While Not infile.atendofstream
  s = infile.readline
  Select Case LCase(s)
    Case "sender:", "receiver:"
      outfile.write s
      For i = 1 To 4
        If Not infile.atendofstream Then
          outfile.writeline infile.readline
        Else
          Exit Do
        End If
      Next
    End Select
  Loop
Next