ファイルを移動して保存するVBAの質問
Sub 納品済みフォルダに移動
If MsgBox(“納品済みフォルダに保存します。“,vbYesNo)= vbNo Then
Exit Sub
Else
End If
Const SPrnDIR =”D:\製品フォルダ\納品済みフォルダ“ ‘親フォルダ
Const SChdDIR = “年“ ‘子フォルダ
Const SChdChdDIR = “月“ ‘孫フォルダ
Const SBkNmTmpl =”.xls” ‘ファイル名
Const SYEAR1st=”4/1” ‘年度の始まりの日付を指定
Dim dtTgt
Dim nCurFisYear As Long
Dim sDir As String
Dim sBkFNm As String
dtTgt = CDate(Range(“L1”).Value)
nCurFisYear = Year(dtTgt) ‘L1セルの年
nCurFismonth = Month(dtTgt) ‘L1セルの月
If dtTgt <Cdate(nCurFisYear＆”/”＆SYEAR1st) Then nCurFisYear = nCurFisYear-1
‘親フォルダの存否確認
If Dir(SPrnDIR, vbDirectory)=”” Then
MsgBox SPrnDIR ＆ vbLf ＆ “フォルダが見つかりません。”,vbExclamation
Exit Sub ‘フォルダが無ければ中止
‘子フォルダ（〇〇〇〇年）の存否確認
sDir = SPrnDIR ＆ “\” nCurFisYear ＆ SChdDIR ‘保存フォルダパス
If Dir(sDir,vbDirectory) = “” Then MkDir sDir ‘子フォルダ無ければ作成
‘孫フォルダ（〇〇月）の存否確認
sDir = sDIR ＆ “\ nCurFisMonth ＆ SChdDIR ‘保存フォルダパス
If Dir(sDir,vbDirectory) = “” Then MkDir sDir ‘子フォルダ無ければ作成
sBkFNm = sDir ＆ “\” ＆ Format(dtTgt,Range(“T6”))＆SBkNmtmpl
‘保存するブック名「〇〇〇〇年◆◆月●日□□□□」で〇は年で◆は月で●は日で〇は製品名
On Error GoTo Exit_
With This Workbook ‘Workbookオブジェクトとして指定
‘保存するファイルの既存確認と上書き確認
If Dir(sBkFNm) 〈〉“” Then
If MsgBox(SPrnDIR ＆ vbLf ＆ “既に存在しています。上書き保存しますか？“,vbYesNo Or vbInformation) = Else Then
Application.DisplayAlerts = False
Else
MsgBox SPrnDIR ＆ vbLf ＆ “ブック保存を中止しました。”,vbInformation
Exit Sub
End If
‘エクセルバージョン移行する場合
ElseIf.FileFormat〈〉xlExcel8 Then
Application.DisplayAlerts = False
End If
‘エクセルファイルをエクセル２００３形式で保存
.saveAs Filename:=sBkFNm,FileFormat:=xlExcel8
End With
Exit_:
Application.Displayalerts = True
End Sub
この様なVBAがあります。
「D:\製品フォルダ\納品前フォルダ」に保存して、開いているエクセルファイルをCommandButtonを押すことで納品済みフォルダに保存します。
質問ですが、納品前フォルダに保存されたエクセルファイルを納品済みフォルダに移動する、又は切り取って貼り付けるVBAが分からないのでどの様にすればよろしいでしょうか？
お礼
大変参考になりました。ご回答ありがとうございます。