각 시트를 워크북에 저장하여 CSV 파일을 구분합니다.

각 시트를 워크북에 저장하여 CSV 파일을 구분합니다.

Excel 워크북에 각 시트를 저장하여 구분CSV매크로를 사용한 파일

나는 여러 개의 시트를 가진 엑셀을 가지고 있는데, 나는 각 시트를 별도의 시트에 저장할 매크로를 찾고 있었다.CSV (comma separated file). Excel에서는 모든 시트를 다른 곳에 저장할 수 없습니다.CSV파일을 표시합니다.

@AlexDuggleby: 워크시트를 복사할 필요가 없습니다.직접 저장할 수 있습니다.예:

Public Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

    SaveToDirectory = "C:\"

    For Each WS In ThisWorkbook.Worksheets
        WS.SaveAs SaveToDirectory & WS.Name, xlCSV
    Next

End Sub

유일한 잠재적인 문제는 워크북이 마지막 CSV 파일로 저장되는 것입니다.원본 워크북을 보관해야 하는 경우 다른 이름으로 저장해야 합니다.

다음은 파일을 저장할 폴더를 선택할 수 있는 시각적 파일 선택 도구와 CSV 구분 기호를 선택할 수 있는 도구입니다(필드에 쉼표가 포함되어 따옴표를 처리하지 않기 때문에 파이프 '|'를 사용합니다).

' ---------------------- Directory Choosing Helper Functions -----------------------
' Excel and VBA do not provide any convenient directory chooser or file chooser
' dialogs, but these functions will provide a reference to a system DLL
' with the necessary capabilities
Private Type BROWSEINFO    ' used by the function GetFolderName
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                             Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                           Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetFolderName(Msg As String) As String
    ' returns the name of the folder selected by the user
    Dim bInfo As BROWSEINFO, path As String, r As Long
    Dim X As Long, pos As Integer
    bInfo.pidlRoot = 0&    ' Root folder = Desktop
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
        ' the dialog title
    Else
        bInfo.lpszTitle = Msg    ' the dialog title
    End If
    bInfo.ulFlags = &H1    ' Type of directory to return
    X = SHBrowseForFolder(bInfo)    ' display the dialog
    ' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetFolderName = Left(path, pos - 1)
    Else
        GetFolderName = ""
    End If
End Function
'---------------------- END Directory Chooser Helper Functions ----------------------

Public Sub DoTheExport()
    Dim FName As Variant
    Dim Sep As String
    Dim wsSheet As Worksheet
    Dim nFileNum As Integer
    Dim csvPath As String


    Sep = InputBox("Enter a single delimiter character (e.g., comma or semi-colon)", _
                   "Export To Text File")
    'csvPath = InputBox("Enter the full path to export CSV files to: ")

    csvPath = GetFolderName("Choose the folder to export CSV files to:")
    If csvPath = "" Then
        MsgBox ("You didn't choose an export directory. Nothing will be exported.")
        Exit Sub
    End If

    For Each wsSheet In Worksheets
        wsSheet.Activate
        nFileNum = FreeFile
        Open csvPath & "\" & _
             wsSheet.Name & ".csv" For Output As #nFileNum
        ExportToTextFile CStr(nFileNum), Sep, False
        Close nFileNum
    Next wsSheet

End Sub



Public Sub ExportToTextFile(nFileNum As Integer, _
                            Sep As String, SelectionOnly As Boolean)

    Dim WholeLine As String
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim StartCol As Integer
    Dim EndCol As Integer
    Dim CellValue As String

    Application.ScreenUpdating = False
    On Error GoTo EndMacro:

    If SelectionOnly = True Then
        With Selection
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    Else
        With ActiveSheet.UsedRange
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    End If

    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = ""
            Else
                CellValue = Cells(RowNdx, ColNdx).Value
            End If
            WholeLine = WholeLine & CellValue & Sep
        Next ColNdx
        WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
        Print #nFileNum, WholeLine
    Next RowNdx

EndMacro:
    On Error GoTo 0
    Application.ScreenUpdating = True

End Sub

다음은 Excel > 2000에서 동작하는 솔루션이지만 2007년에 테스트된 솔루션입니다.

Private Sub SaveAllSheetsAsCSV()
On Error GoTo Heaven

' each sheet reference
Dim Sheet As Worksheet
' path to output to
Dim OutputPath As String
' name of each csv
Dim OutputFile As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

' ask the user where to save
OutputPath = InputBox("Enter a directory to save to", "Save to directory", Path)

If OutputPath <> "" Then

    ' save for each sheet
    For Each Sheet In Sheets

        OutputFile = OutputPath & "\" & Sheet.Name & ".csv"

        ' make a copy to create a new book with this sheet
        ' otherwise you will always only get the first sheet
        Sheet.Copy
        ' this copy will now become active
        ActiveWorkbook.SaveAs FileName:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close
    Next

End If

Finally:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

Exit Sub

Heaven:
MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
        "Source: " & Err.Source & " " & vbCrLf & _
        "Number: " & Err.Number & " " & vbCrLf & _
        "Description: " & Err.Description & " " & vbCrLf

GoTo Finally
End Sub

(OT: SO가 제 마이너 블로그를 대체할 수 있을까요?)

Graham의 답변을 바탕으로 추가 코드는 워크북을 원래 형식으로 원래 위치에 저장합니다.

Public Sub SaveWorksheetsAsCsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

 CurrentWorkbook = ThisWorkbook.FullName
 CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook

      SaveToDirectory = "C:\"

      For Each WS In ThisWorkbook.Worksheets
          WS.SaveAs SaveToDirectory & WS.Name, xlCSV
      Next

 Application.DisplayAlerts = False
  ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
 Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub

Alex에서 답변해야 할 작은 수정 사항은 자동 계산을 켜고 끄는 것입니다.

놀랍게도 수정되지 않은 코드는 VLOOKUP에서는 정상적으로 동작하고 있었지만 OFFSET에서는 실패했습니다.또한 자동 계산을 해제하면 저장 속도가 대폭 향상됩니다.

Public Sub SaveAllSheetsAsCSV()
On Error GoTo Heaven

' each sheet reference
Dim Sheet As Worksheet
' path to output to
Dim OutputPath As String
' name of each csv
Dim OutputFile As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

' Save the file in current director
OutputPath = ThisWorkbook.Path


If OutputPath <> "" Then
Application.Calculation = xlCalculationManual

' save for each sheet
For Each Sheet In Sheets

    OutputFile = OutputPath & Application.PathSeparator & Sheet.Name & ".csv"

    ' make a copy to create a new book with this sheet
    ' otherwise you will always only get the first sheet

    Sheet.Copy
    ' this copy will now become active
     ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV,     CreateBackup:=False
    ActiveWorkbook.Close
Next

Application.Calculation = xlCalculationAutomatic

End If

Finally:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

Exit Sub

Heaven:
MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
        "Source: " & Err.Source & " " & vbCrLf & _
        "Number: " & Err.Number & " " & vbCrLf & _
        "Description: " & Err.Description & " " & vbCrLf

GoTo Finally
End Sub

저와 같은 Mac 사용자에게는 다음과 같은 몇 가지 기능이 있습니다.

원하는 디렉토리에 저장할 수 없습니다.저장된 파일을 수신할 수 있는 것은, 그 중 몇개뿐입니다.자세한 내용은 이쪽

다음은 Mac용 Excel에 붙여넣기를 복사할 수 있는 작업 스크립트입니다.

Public Sub SaveWorksheetsAsCsv()

 Dim WS As Excel.Worksheet
 Dim SaveToDirectory As String

 SaveToDirectory = "~/Library/Containers/com.microsoft.Excel/Data/"

 For Each WS In ThisWorkbook.Worksheet
    WS.SaveAs SaveToDirectory & WS.Name & ".csv", xlCSV
 Next

End Sub

Visual Basic을 사용하여 워크시트를 루프하고 저장.csv파일을 표시합니다.

1. 열어 보세요..xlsxExcel로 파일합니다.

2. +F11 를 누릅니다.

3. Insert→Module

4. 모듈 코드에 삽입:

   Public Sub SaveWorksheetsAsCsv()
   
    Dim WS As Excel.Worksheet
    Dim SaveToDirectory As String
   
    SaveToDirectory = "./"
   
    For Each WS In ThisWorkbook.Worksheets
       WS.SaveAs SaveToDirectory & WS.Name & ".csv", xlCSV
    Next
   
   End Sub
   

5. 모듈을 실행합니다.

   (즉, 상단에 있는 재생 버튼을 클릭한 다음 대화상자가 나타나면 "실행"을 클릭합니다.)

6. 검색(Find your find your ★.csv파일~/Library/Containers/com.microsoft.Excel/Data.

   open ~/Library/Containers/com.microsoft.Excel/Data
   

7. 가까운..xlsx파일.

8. 헹군 후 다른 항목에 대해서도 반복합니다..xlsx파일을 표시합니다.

Von Pookie의 답변을 확인해 주세요.모든 크레딧은 그/그녀에게 돌려주세요.

 Sub asdf()
Dim ws As Worksheet, newWb As Workbook

Application.ScreenUpdating = False
For Each ws In Sheets(Array("EID Upload", "Wages with Locals Upload", "Wages without Local Upload"))
   ws.Copy
   Set newWb = ActiveWorkbook
   With newWb
      .SaveAs ws.Name, xlCSV
      .Close (False)
   End With
Next ws
Application.ScreenUpdating = True

End Sub

언급URL : https://stackoverflow.com/questions/59075/save-each-sheet-in-a-workbook-to-separate-csv-files