お世話になります。

こんな感じでどうでしょうか

Sub Macro()
    Dim FSO
    Dim c As Long
    'ファイルを作る場所を指定
    Const myPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\test1"
    
    c = 1
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    '同名フォルダが存在する場合のエラーを無視します
    On Error Resume Next
    
    While Cells(1, c).Value <> ""
        FSO.CreateFolder (myPath & "\" & Cells(1, c).Value)
    
        With FSO.GetFolder(myPath & "\" & Cells(1, c).Value).CreateTextFile(Cells(2, c).Value & ".txt")
            .WriteLine Cells(3, c).Value
            .WriteLine Cells(4, c).Value
            .WriteLine Cells(5, c).Value
        End With
        c = c + 1
    Wend
    On Error GoTo 0
    
    Set FSO = Nothing
End Sub

\を￥（半角）に置き換えてください。

http://q.hatena.ne.jp/