Sub CSVOut_A()

Dim Folder1 As String
Dim CSVFile As Workbook
Dim PrebookName As String
Dim PreLastRow As Long
Dim fileNME As String
Dim VocExcelCSV As String



On Error GoTo line


'############# CSVフォルダを作成

Folder1 = "CSV"

ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path 'エクセルファイルのある場所に移動する

If Dir(ThisWorkbook.Path & "\" & Folder1, vbDirectory) = "" Then 'folder1の中身が空だったら

MkDir Folder1 'Folder1 = "CSV" / フォルダ名「CSV」のフォルダを作成

End If



Application.ScreenUpdating = False


'############# 必要なパスなど

ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path 'エクセルファイルのある場所に移動する




'############# 単語帳の元データをコピーしておく

PrebookName = ActiveWorkbook.Name '※１

Workbooks(PrebookName).Activate
ActiveSheet.Select


PreLastRow = ActiveSheet.Cells(65536, "B").End(xlUp).Row '最終行
ActiveSheet.Range(Cells(10, "B"), Cells(PreLastRow, "AZ")).Select

Selection.Copy






'############# 新しいワークブック開く
Set CSVFile = Workbooks.Add(xlWorksheet)




'############# 新しいワークブックをCSVファイルとして保存する

fileNME = "VocCSV_" & Format(Date, "yymmdd") & "_" & Format(Now, "hhmmss") & ".csv"
VocExcelCSV = ThisWorkbook.Path & "\CSV\" & fileNME 'ファイル名の決定


With CSVFile
.Sheets(1).Cells(1, "A").Select

Selection.PasteSpecial Paste:=xlValues '値のみ
'Selection.PasteSpecial Paste:=xlFormats '書式のみ

Application.DisplayAlerts = False
.SaveAs VocExcelCSV, xlCSV '実際にCSVファイルを保存する
.Close Savechanges:=False
End With



'############ 後処理

With Application
.CutCopyMode = False
.DisplayAlerts = True
'.ScreenUpdating = True
End With



MsgBox "《CSV出力》CSVフォルダーに保存しました。　" & Chr(13) & Chr(13) & "→ ファイル名 : " & fileNME


Application.ScreenUpdating = True


Exit Sub


line:

MsgBox "エラーが発生しました。処理を中止します。"

Application.ScreenUpdating = True

End Sub