列区切り形式を維持したままcsv形式でワークシートを保存する方法は？

Question

ソース（シート）から複数のシートを作成するVBAコードを作成しています。私はバッチ入力のためにそれらを使用するためにCSV形式でそれらを別々に保存しようとしています。ただし、保存されたワークシートは、CSVファイルの中で「列分離形式」のままでなければなりません。

For i = 0 To nb 
If Sheets("PjtDef").Range("A2").Offset(k + i, 0).Value <> "" Then 
    Sheets("PjtDef").Range("A2").Offset(k + i, 0).Select 
    Sheets("PjtDef").Range("A1", ActiveCell).EntireRow.Copy 
    Sheets.Add 
    ActiveSheet.Name = h 
    ActiveSheet.Paste 
    Worksheets("PjtDef").Activate 
    Sheets("PjtDef").Range("A2").Offset(k + i, 0).Select 
    Range("A2", ActiveCell).EntireRow.Delete Shift:=xlUp 
    h = h + 1 
Else: i = nb 
End If 
Next i 

Dim xWs As Worksheet 
Dim xcsvFile As String 
For Each Scut In Application.ActiveWorkbook.Worksheets 
    Scut.Copy 
    Name = CurDir & "\" & Scut.Name & ".csv" 
    Application.ActiveWorkbook.SaveAs Filename:=Name, _ 
    FileFormat:=xlCSV, CreateBackup:=False 
    Application.ActiveWorkbook.Saved = True 
    Application.ActiveWorkbook.Close 
Next 
Application.ScreenUpdating = True 
End Sub 

Answer 1

私は次のコードの作業を持っている：ここで

は私がでてるところです

Sub ExportFile() 
Const myDelim As String = "|" 

Dim Sheet As Object 
Set Sheet = Worksheets 
For p = 1 To 2 'you could use sheet.count 
Sheet(p).Activate 

Dim ws As Worksheet 
Set ws = ActiveSheet 
Dim r As Long, c As Long, i As Long, j As Long 
r = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
c = ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
Dim myPath As String 
myPath = ThisWorkbook.Path & "\" 
Dim myFile As String 

filename = ws.name 
myFile = myPath & filename & ".extention" 
Dim obj As Object 
Set obj = CreateObject("ADODB.Stream") 
obj.Type = 2 
obj.Charset = "ASCII" 
obj.Open 
Dim v() As Variant 
ReDim v(1 To c) 

For i = 3 To r - 1 
For j = 1 To c 
v(j) = ws.Cells(i, j).Text 
Next 
obj.WriteText Join(v, myDelim), 1 
Next 
obj.SaveToFile myFile, 2 
End Sub 

これは、使用した行のセルを分離するファイルへのすべてのシートを書き、「|」