Sub CreateTxtDataS()
'全シートを1シート毎にカンマ区切りcsvファイルとして出力する
'シート名はファイル名として使用
'2005/02/13 pPoy
    Dim fso As Object               'FileSystemObject
    Dim ffile As Object             'TextStream
    Dim myData As Range             'データ領域格納
    Dim myTmp As String             '出力するデータ
    Dim txtName As String           'csvファイル名=シート名
    
    Dim w As Worksheet
    Dim i As Long, j As Long
    Const myPath = "C:\Test"        'csvファイルのパス

    Set fso = CreateObject("Scripting.FileSystemObject")
    
    For Each w In Worksheets
        'シート名をファイル名にセット
        txtName = w.Name & ".csv"
        'csvファイル作成
        Set ffile = _
            fso.CreateTextFile(myPath & "\" & txtName, True)
        'A1から始まる全データ範囲取得
        Set myData = w.Range("A1").CurrentRegion
        
        '範囲内の全行数ループ
        For i = 1 To myData.Rows.Count
            myTmp = ""
            '範囲内の1行ループ
            For j = 1 To myData.Columns.Count
                'データ格納
                If myTmp = "" Then
                    '最初のデータ
                    myTmp = myData(i, j)
                Else
                    '残りのデータはカンマでつなげる
                    myTmp = myTmp & "," & myData(i, j)
                End If
            Next j
            
            'テキストファイル出力
            If myTmp <> "" Then
                ffile.WriteLine myTmp
            End If
        Next i
    Next w
    MsgBox "処理終了〜！", vbOKOnly
    
    '変数開放
    ffile.Close: Set myData = Nothing
    Set ffile = Nothing: Set fso = Nothing
End Sub

• このマクロは、アクティブなブックの全ワークシートが対象です。
• 行の途中に空白行があった場合、そこが表の最後と判断します。それより下のデータは出力できません。
  
• 列の途中に空白列があった場合、そこが表の右端と判断します。それより右のデータは出力できません。
  
• 表は、「A1」 セルから始まっていることが必要です。
  
• 出力用の「C:\Test」 フォルダが必要です。無い場合、エラーで止まります。
• 指定されたフォルダに、同名の CSV ファイルがあった場合、無条件で上書きされます。
  必要なファイルは退避してからマクロを実行してください。
  
• FileSystemObject を使用しているため、Windows98 以降の OS が対象です。