ExcelマクロCSVへ複数のシート

Question

49枚を個別のCSVファイルに分割するためにExcelで実行しているマクロがあります。

しかし、それはライン上に巻き込まれている。ここ7

Application.ActiveWorkbook.SaveAs Filename: = xcsvFile, _ 
    FileFormat: = xlCSV, CreateBackup: = False 

周囲のコードです：ワークブックのシートごとに

Sub ExportSheetsToCSV() 

    Dim xWs As Worksheet 
    For Each xWs In Application.ActiveWorkbook.Worksheets 

     xWs.Copy 

     Dim xcsvFile As String 
     xcsvFile = CurDir & "\" & xWs.Name & ".csv" 

     Application.ActiveWorkbook.SaveAs Filename: = xcsvFile, _ 
      FileFormat: = xlCSV, CreateBackup: = False 

     Application.ActiveWorkbook.Saved = True 
     Application.ActiveWorkbook.Close 

    Next 

End Sub 

Answer 1

は、各シートの名前のcsvファイルを転送します。

Sub ExportSheetsToCSV() 

    Dim Ws As Worksheet 
    Dim xcsvFile As String 
    Dim rngDB As Range 

    For Each Ws In Worksheets 
     xcsvFile = CurDir & "\" & Ws.Name & ".csv" 
     With Ws 
      r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
      c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
      Set rngDB = .Range("a1", .Cells(r, c)) 
     End With 
     TransToCSV xcsvFile, rngDB 
    Next 
    MsgBox ("Files Saved Successfully") 
End Sub 

Sub TransToCSV(myfile As String, rng As Range) 

    Dim vDB, vR() As String, vTxt() 
    Dim i As Long, n As Long, j As Integer 
    Dim objStream 
    Dim strTxt As String 

    Set objStream = CreateObject("ADODB.Stream") 
    vDB = rng 
    For i = 1 To UBound(vDB, 1) 
     n = n + 1 
     ReDim vR(1 To UBound(vDB, 2)) 
     For j = 1 To UBound(vDB, 2) 
      vR(j) = vDB(i, j) 
     Next j 
     ReDim Preserve vTxt(1 To n) 
     vTxt(n) = Join(vR, ",") 
    Next i 
    strTxt = Join(vTxt, vbCrLf) 
    With objStream 
     '.Charset = "utf-8" 
     .Open 
     .WriteText strTxt 
     .SaveToFile myfile, 2 
     .Close 
    End With 
    Set objStream = Nothing 

End Sub 

Answer 2

これを考慮してください。

Sub test() 

    Dim ws As Worksheet 
    Dim GetSheetName As String 

    For Each ws In ThisWorkbook.Worksheets 
     If ws.Name <> "Sheet1" Then ' Assuming there is one sheet that you DON'T want to save as a CSV 

     ws.Select 
     GetSheetName = ActiveSheet.Name 
      Set shtToExport = ActiveSheet  ' Sheet to export as CSV 
       Set wbkExport = Application.Workbooks.Add 
       shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count) 
       Application.DisplayAlerts = False  ' Possibly overwrite without asking 
       wbkExport.SaveAs Filename:="C:\your_path_here\Desktop\" & GetSheetName & ".csv", FileFormat:=xlCSV 
       Application.DisplayAlerts = True 
       wbkExport.Close SaveChanges:=False 

     End If 
    Next ws 

End Sub