Public Const NETMaster As String = "D:0_マスタ\マスタ_経費請求申請と承認(スポットと定期).xlsm"

 

Sub 今年度空ファイル作成()

 

高速開始

 

    Dim myFolderPath As String

    Dim myFileName As String

    Dim shinFile As String

    Dim today As String

    Dim NET As String

    Dim 事業場 As String

    Dim 事業場No As String

    Dim filepath As String

    Dim i As Long

    Dim ei As Long

    

    Dim SetFile As String

    Dim wbMoto As Workbook, wbSaki As Workbook

    Dim FileName As String

    Dim endrow As String

    

    Application.DisplayAlerts = False                               '画面ちらつき防止停止

                                                                'マスターデータ取り込み元をブック名をセット（取り込み元）"

    Application.StatusBar = "■■■■■共通マスタ取込中■■■■■"   '進行状況をステータスバーへ表示する

 

    Set wbMoto = Workbooks("マスタ.xlsm")

    SetFile = NETMaster

   

    Set wbSaki = Workbooks.Open(NETMaster)

    

    Workbooks.Open FileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'マスターデータファイルを読み取り専用で開きます（）

    Application.StatusBar = "■■■■■共通マスタ取込中■■■■■"

        '既存マスタ

     i = wbMoto.Sheets("事業場共通").Range("K" & Rows.Count).End(xlUp).Row  '最終行

        wbMoto.Worksheets("事業場共通").Range("A2:R" & i).Copy             'シート名の「事業場共通」税区分までの範囲をコピー

        wbSaki.Worksheets("マスタ").Range("A1").PasteSpecial xlPasteFormulasAndNumberFormats  'シート名「マスタ」A1から貼り付け

        Application.CutCopyMode = False 'コピー切り取りを解除

    Application.StatusBar = "■■■■■部署マスタ取込中■■■■■"

        

        '部署マスタ

     i = wbMoto.Worksheets("事業場共通").Range("T" & Rows.Count).End(xlUp).Row  '最終行

        wbMoto.Worksheets("事業場共通").Range("T2:U" & i).Copy             'シート名の「事業場共通」部署マスタの範囲をコピー

        wbSaki.Worksheets("マスタ").Range("Z1").PasteSpecial xlPasteFormulasAndNumberFormats  'シート名「マスタ」A1から貼り付け

        Application.CutCopyMode = False 'コピー切り取りを解除

       '会社マスタ～社員マスタ

    Application.StatusBar = "■■■■■事業場別承認マスタ取込中■■■■■"

 

     i = wbMoto.Worksheets("事業場共通").Range("AC" & Rows.Count).End(xlUp).Row  '最終行

        wbMoto.Worksheets("事業場共通").Range("W2:AJ" & i).Copy             'シート名の「Mマスタ」セルの範囲をコピー

        wbSaki.Worksheets("マスタ").Range("AC1").PasteSpecial xlPasteFormulasAndNumberFormats  'シート名「マスタ」A1から貼り付け

        Application.CutCopyMode = False 'コピー切り取りを解除

           

   ei = wbMoto.Worksheets("事業場共通").Range("AB" & Rows.Count).End(xlUp).Row  '最終行

     For i = 3 To ei

     

     today = Format(Date, "yyyy") + 1

    Set wbMoto = Workbooks("マスタ.xlsm")

    Set wbSaki = Workbooks("マスタ_経費請求申請と承認(スポットと定期).xlsm")

     

   事業場 = wbMoto.Sheets("事業場共通").Range("AB" & i).Value

    Application.StatusBar = "■■■■■" & 事業場 & "のファイル作成中■■■■■"

   事業場No = wbMoto.Sheets("事業場共通").Range("Z" & i).Value

   filepath = 事業場No & "_" & 事業場

   

       endrow = wbMoto.Worksheets(事業場).Range("A" & Rows.Count).End(xlUp).Row

        wbMoto.Worksheets(事業場).Range("A2:U" & endrow).Copy             'シート名の「Mマスタ」セルの範囲をコピー

        wbSaki.Worksheets("マスタ").Range("AV1").PasteSpecial xlPasteFormulasAndNumberFormats  'シート名「マスタ」A1から貼り付け

        Application.CutCopyMode = False 'コピー切り取りを解除

      

     wbSaki.Worksheets("スポット一覧").Range("C4").Value = 事業場

     wbSaki.Worksheets("定期購入").Range("C4").Value = 事業場

    Application.DisplayAlerts = True                                 '画面ちらつき防止停止

 

NET = "\\192.168.1.9\network-data\事業場\00 全般\個人フォルダ\" & filepath & "\"

 

   myFolderPath = NET

 

    myFileName = today & "_" & 事業場 & "経費請求申請と承認(スポットと定期).xlsm"

    

    shinFile = myFolderPath & myFileName

    

    

    ActiveWorkbook.SaveCopyAs shinFile

    

    Next i

        wbSaki.Close False

            Set wbSaki = Nothing

            Set wbMoto = Nothing

    Application.StatusBar = False

    

    高速終了

End Sub

 

★ボタンクリックでYesNoで分岐

Private Sub CommandButton1_Click() '年度更新

        Dim rc As VbMsgBoxResult

        rc = MsgBox("次年度のファイルを作成しますか？", vbYesNo + vbQuestion)

        If rc = vbYes Then

            MsgBox "次年度のファイルを作成します", vbInformation      

            今年度空ファイル作成

           MsgBox "完了"

           ActiveWorkbook.Close SaveChanges:=False

        Else

            MsgBox "中止します", vbCritical

        End If

End Sub