【ダウンロード】0.1 まずはこのExcelマクロテンプレートから始めてみよう！

Option Explicit

Dim ws_macro As Worksheet

Sub initialize()

    Set ws_macro = ThisWorkbook.Worksheets("Excelマクロ作成用テンプレートマクロ")

End Sub

Sub select_inputfile()

    Dim str_filepath As String

    Call initialize

    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Excelファイル", "*.xls*"
        .AllowMultiSelect = False
        If .Show = True Then
            str_filepath = .SelectedItems(1)
            ws_macro.Range("C3") = Right(str_filepath, Len(str_filepath) - InStrRev(str_filepath, "\"))
            ws_macro.Range("D3") = Left(str_filepath, InStrRev(str_filepath, "\") - 1)
        End If
    End With

End Sub

Sub select_outputfolder()

    Call initialize

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = True Then
            ws_macro.Range("D4") = .SelectedItems(1)
        End If
    End With

End Sub

Sub execute_templatemacro()

    Dim fso As New FileSystemObject
    Dim wb_inputfile As Workbook
    Dim ws_inputfile As Worksheet
    Dim path_inputfile As String
    Dim wb_outputfile As Workbook
    Dim ws_outputfile As Worksheet
    Dim path_outputfile As String
    Dim num_row As Long
    
    Application.ScreenUpdating = False
    
    Call initialize

    '入力ファイルの妥当性チェック
    If ws_macro.Range("C3") = "" Or ws_macro.Range("D3") = "" Then
        MsgBox ws_macro.Range("B3") & "のフォルダのフルパス、またはファイル名が未入力です。"
        ws_macro.Activate
        Application.ScreenUpdating = True
        End
    End If
    
    If Right(ws_macro.Range("D3"), 1) <> "\" Then
        path_inputfile = ws_macro.Range("D3") & "\" & ws_macro.Range("C3")
    Else
        path_inputfile = ws_macro.Range("D3") & ws_macro.Range("C3")
    End If
    
    If fso.FileExists(path_inputfile) = False Then
        MsgBox ws_macro.Range("B3") & "が存在しません。"
        ws_macro.Activate
        Application.ScreenUpdating = True
        End
    End If

    '出力フォルダの妥当性チェック
    If ws_macro.Range("D4") = "" Then
        MsgBox ws_macro.Range("B4") & "のフォルダのフルパスが未入力です。"
        ws_macro.Activate
        Application.ScreenUpdating = True
        End
    End If
    
    If Right(ws_macro.Range("D4"), 1) <> "\" Then
        path_outputfile = ws_macro.Range("D4") & "\"
    Else
        path_outputfile = ws_macro.Range("D4")
    End If
    
    If fso.FolderExists(path_outputfile) = False Then
        MsgBox ws_macro.Range("B4") & "が存在しません。"
        ws_macro.Activate
        Application.ScreenUpdating = True
        End
    End If
   
    Workbooks.Open Filename:=path_inputfile
    Set wb_inputfile = ActiveWorkbook
    Set ws_inputfile = ActiveWorkbook.Worksheets(1)
    
    ws_inputfile.Copy
    Set wb_outputfile = ActiveWorkbook
    
    wb_outputfile.SaveAs Filename:=path_outputfile & "出力ファイル_" & Format(Now, "yyyymmddhhmmss") & ".xlsx"

    wb_outputfile.Close SaveChanges:=False

    wb_inputfile.Close SaveChanges:=False
    
    MsgBox "入力ファイルの1つ目のワークシートを、出力ファイルにコピーしました。"
    
    ws_macro.Activate

    ThisWorkbook.Save
    
    Application.ScreenUpdating = True

End Sub