※ ChatGPTを利用し、要約された質問です(原文:シートの複写をデスクトップのフォルダに挿入したい)
シートの複写をデスクトップのフォルダに挿入したい
このQ&Aのポイント
Excel2007でマクロ作成中の初心者です。今正常に作動しているマクロコード「この計算シートの保存」をもとに「この計算シートをデスクトップの決まったフォルダに挿入」としたいです。どう変更したらいいかご指導お願いします。
マクロコード「この計算シートをデスクトップの決まったフォルダに挿入」の作成方法を教えてください。Excel2007でマクロ作成中です。
デスクトップのフォルダに「この計算シート」を挿入するためのマクロコードを教えてください。Excel2007を使用しています。
Excel2007でマクロ作成中の初心者です。
今正常に作動しているマクロコード「この計算シートの保存」をもとに
「この計算シートをデスクトップの決まったフォルダに挿入」としたいです。
どう変更したらいいかご指導お願いします。
-------------------------------------------
Sub この計算シートをデスクトップの決まったフォルダに挿入() '
'Const cnsTITLE = "マクロなしブックの作成"
'Const cnsFILTER = "Excelワークブック (*.xls),*.xls"
Dim xlAPP As Application
Dim WBK1 As Workbook ' 本ブックの
Dim WBK2 As Workbook ' 作成ブック(新規ブック)
Dim strFileName As String
Dim tblSH As Variant
Dim lngLines As Long
Dim myDate As String
myDate = Range("AE4").Value
'Date = Format(Date, "ge年m月度")
Set WBK1 = ThisWorkbook ' 本ブック
' この計算シートをデスクトップの「計算書庫」フォルダに挿入する
Worksheets("この計算シート").Copy
Set WBK2 = ActiveWorkbook
strFileName = Format(myDate, "ge年m月度") & ".xls"
ChDir ThisWorkbook.Path + "\計算書庫" 'デスクトップの「計算書庫」フォルダに変更したい
Application.DisplayAlerts = False
WBK2.SaveAs "定期計算書" & strFileName, FileFormat:=XlFileFormat.xlExcel8
MsgBox "この計算書を " & myDate & " の名前でデスクトップの「計算書庫」フォルダに挿入しました。"
Application.DisplayFormulaBar = True
WBK2.Close False
Application.DisplayAlerts = True
Set WBK2 = Nothing
MAKE_NEWBOOK_WO_MACROS_EXIT:
Set WBK1 = Nothing
Set xlAPP = Nothing
End Sub
----------------------------------------------
Sub この計算シートの保存() '
'Const cnsTITLE = "マクロなしブックの作成"
'Const cnsFILTER = "Excelワークブック (*.xls),*.xls"
Dim xlAPP As Application
Dim WBK1 As Workbook ' 本ブックの
Dim WBK2 As Workbook ' 作成ブック(新規ブック)
Dim strFileName As String
Dim tblSH As Variant
Dim lngLines As Long
Dim myDate As String
myDate = Range("AE4").Value
'Date = Format(Date, "ge年m月度")
Set WBK1 = ThisWorkbook ' 本ブック
' この計算シートを新規ブックにコピーする
Worksheets("この計算シート").Copy
Set WBK2 = ActiveWorkbook
strFileName = Format(myDate, "ge年m月度") & ".xls"
ChDir ThisWorkbook.Path + "\計算書庫"
Application.DisplayAlerts = False
WBK2.SaveAs "計算書庫"" & strFileName, FileFormat:=XlFileFormat.xlExcel8
MsgBox "この計算書を " & myDate & " の名前で保存しました。"
Application.DisplayFormulaBar = True
WBK2.Close False
Application.DisplayAlerts = True
Set WBK2 = Nothing
MAKE_NEWBOOK_WO_MACROS_EXIT:
Set WBK1 = Nothing
Set xlAPP = Nothing
End Sub
補足
ご指摘のとおりやってみましたらデスクトップのフォルダに保存できました。ありがとうございました。