ExcelVBAロボット。ファイルのコピーと新しいシートを追加して！

作業全体の流れ

取引先へ贈答した、お中元、お歳暮のリストの過去のものがずらっと並んだ贈答品.xlsxがあります。新シート、今回だと[2022お歳暮]のシートを作り⇒「今年のお歳暮どうするか考え、決めて」⇒リスト仕上げ、注文書を作ります。

贈答品.xlsx 

いったん、作業用のエクセルをコピーしてそれで行います。
（ダイレクトにもとを書き換えてもいいですが・・・）

１．エクセルをこうして

①前作業：贈答品エクセルファイルをコピーして作業用をつくり
　今年のシートを追加　（A）・（B）・（C）
②本作業：今年の案を考える。過去のデータより検討表　（D）・（E）
　21行目以下に書き出し
③後作業：今年のシート・注文書を作る　（F）・（G）

ExcelVBAロボット.xlsm

２．動いてるトコロはこんなカンジ

①前作業：贈答品エクセルファイルをコピーして作業用をつくり
　今年のシートを追加　（A）・（B）・（C）
　の部分です

３．コードをコピペ、ボタンを設定

①贈答品エクセルファイルをコピーして作業用をつくり
　今年のシートを追加　（A）・（B）・（C）

Sub ファイルをコピー() 'ボタン1に設定

Application.ScreenUpdating = False 'スクリーンOFF

Sheets("Sheet1").Select  'シートの選択

'コピーもと
moto = Range("C3") & "\" & Range("D3") & Range("E3")

'コピー先
saki = Range("C5") & "\" & Range("D5") & Range("E5")

MsgBox ("コピーもと；" & moto)
MsgBox ("コピー先：" & saki)
    

'ターゲット開いていたら止める()
On Error Resume Next
Open moto For Append As #1
Close #1
If Err.Number > 0 Then
    MsgBox ("ファイルは開いているか" & _
    Chr(13) & Chr(10) & _
    "回線が繋がっていません。コピーは止めます")

Else
    FileCopy moto, saki 'ファイルをコピー

End If

MsgBox ("終了しました")
Sheets("Sheet1").Select  'シートの選択
Application.ScreenUpdating = True 'スクリーンON

End Sub

Sub シートをコピー() 'ボタン2に設定

Application.ScreenUpdating = False 'スクリーンOFF

Sheets("Sheet1").Select  'シートの選択

'ターゲットのフォルダ名：ディレクトリ名
pt = Range("C5")
'ファイル名
fn = Range("D5") & Range("E5")
'ファイル名（フルパス）
t_fll = pt & "\" & fn
        
'コピーもと
moto = Range("C8")

'コピー先
saki = Range("C10")

MsgBox ("もとシート；" & moto)
MsgBox ("先シート：" & saki)

'ターゲットファイルが開いていたら閉じる
On Error Resume Next
Open t_fll For Append As #1 '★
Close #1
If Err.Number > 0 Then
    Workbooks(fn).Activate '★
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Application.CutCopyMode = True
End If
        
'ファイルを開く
Workbooks.Open Filename:=t_fll

'シートをコピー
Worksheets(moto).Copy Before:=Worksheets(moto)
ActiveSheet.Name = saki

'ターゲットファイルを閉じる()
For Each wb In Workbooks
  If wb.Name = fn Then '★
    Application.CutCopyMode = False
    wb.Close SaveChanges:=True
    Application.CutCopyMode = True
  End If
Next
 

MsgBox ("終了しました")
Sheets("Sheet1").Select  'シートの選択
Application.ScreenUpdating = True 'スクリーンON

End Sub

Sub 記載書換データクリア() 'ボタン3に設定

    Application.ScreenUpdating = False 'スクリーンOFF
    
    Sheets("Sheet1").Select  'シートの選択
    
    'ターゲットのフォルダ名：ディレクトリ名
    pt = Range("C5")
    'ファイル名
    fn = Range("D5") & Range("E5")
    'ファイル名（フルパス）
    t_fll = pt & "\" & fn
            
    'ターゲットシート
    t_sheet = Range("C10")
    
    '年・表題名・クリア開始する行を指定
    nen = Range("G9")
    gift = Range("H9")
    gyo = Range("I9")

    'ターゲットファイルが開いていたら閉じる
    On Error Resume Next
    Open t_fll For Append As #1 '★
    Close #1
    If Err.Number > 0 Then
        Workbooks(fn).Activate '★
        Application.CutCopyMode = False
        ActiveWorkbook.Close
        Application.CutCopyMode = True
    End If
            
    'ファイルを開く
    Workbooks.Open Filename:=t_fll
    
    'コピー先の記載書換・データクリア
    Sheets(t_sheet).Select
    Range("C1") = nen
    Range("D1") = gift
    
    '前に書き出した一覧表クリア
    maxRow = Range("A65536").End(xlUp).Row
    If maxRow >= gyo Then
        Range(Cells(gyo, 1), Cells(maxRow, 6)).Select
        Selection.ClearContents
    End If
    
    Cells(gyo, 1).Select
    
    'ターゲットファイルを閉じる(SaveChanges:=True)
    For Each wb In Workbooks
      If wb.Name = fn Then '★
        Application.CutCopyMode = False
        wb.Close SaveChanges:=True
        Application.CutCopyMode = True
      End If
    Next

    MsgBox ("終了しました")
    Sheets("Sheet1").Select  'シートの選択
    Application.ScreenUpdating = True 'スクリーンON
 
End Sub

次回は、本処理！

仕事の本題の部分です。今年どうするか案を作ります
そのために、過去のデータより検討一覧を作ります。

不明点は、ご連絡いただいて結構です。
（すぐにとか、直接）お答えできないときはすみません。
note初心者なんで、noteのコミュニケートの方法よく分かりませんが ^^；
Twitterでも。どのツイートでも返信に「noteを見た」で良いです。
出来高急増！

Tweets by assist_life