connection_books.bas

Sub ConnectionBooks()
	Dim FPath1 As String, FPath2, FileType As String
	Dim OutFileName As String
	Dim FName As String, myBook As String
	Application.ScreenUpdating = False

	FPath1 = Application.InputBox("どこのフォルダ内を結合？(ディレクトリ指定）", "取込先", Type:=2)
	FPath2 = Application.InputBox("どこの保存？(ディレクトリ指定）", "出力先", Type:=2)
	OutFileName = Application.InputBox("出力ファイル名", "ファイル名", Type:=2)
	FileType = Application.InputBox("結合するファイル拡張子の指定", "拡張子", Type:=2)

    If (Right(FPath1, 1) <> "\") Then FPath1 = FPath1 & "\"
    If (Right(FPath2, 1) <> "\") Then FPath2 = FPath2 & "\"
    if (Left(FileType, 1) <> ".") Then FileType = "." & FileType 

	Workbooks.Add
	myBook = ActiveWorkbook.Name
	FName = Dir$(FPath1 & "*" & FileType)

	Do While FName <> ""
		Workbooks.Open Filename:=FPath1 & FName
		ActiveWorkbook.Sheets.Select
		Sheets(1).Activate
		Sheets.Copy After:=Workbooks(myBook).Sheets(Sheets.Count)
		Workbooks(FName).Activate
		Application.DisplayAlerts = False
		ActiveWorkbook.Close
		FName = Dir$
	Loop

	ActiveWorkbook.SaveAs Filename:=FPath2 & OutFileName & FileType, FileFormat:=xlNormal
	ActiveWorkbook.Close
	Application.ScreenUpdating = True
End Sub

split_for_book.bas

Sub splitBook()

    Dim myWorksheet As Worksheet
    Dim SeetName, path, FileType As String
    
    path = Application.InputBox("どこに出力？(ディレクトリ指定）", "出力先", Type:=2)
    FileType = Application.InputBox("ファイル拡張子の指定", "拡張子", Type:=2)

    If (Right(path, 1) <> "\") Then path = path & "\"
    if (Left(FileType, 1) <> ".") Then FileType = "." & FileType 

    For Each myWorksheet In Worksheets
        SeetName = myWorksheet.Name
        myWorksheet.Copy
        SeetName = Replace(SeetName, "|", "｜")
        ActiveWorkbook.SaveAs path & SeetName & FileType
        '保存した分割ブックを閉じたい場合。開いておきたい場合は、下の行の先頭に
        'アポストロフィーをいれる。
        ActiveWorkbook.Close savechanges:=True
    Next myWorksheet

End Sub

Substitution_Hiper_Link.bas

Sub SubstitutionHiperLink()
    Dim OldStr As String
    Dim NewStr As String
    
    OldStr = Application.InputBox("どの文字を変更？", "変換前文字", Type:=2)
    NewStr = Application.InputBox("何に変える？", "返還後文字", Type:=2)
    
    If (OldStr <> "False") Then
        If NewStr = "False" Then NewStr = ""
        For Each hlink In ActiveSheet.Hyperlinks
            hlink.SubAddress = Replace(hlink.SubAddress, OldStr, NewStr)
        Next
    End If
End Sub

substitution_sheet_name.bas

Sub SubstitutionSheetName()
    Dim ws As Worksheet
    Dim myFind As String
    Dim myReplace As String
     
    myFind = Application.InputBox("検索文字列は？", "シート名置換", Type:=2)
    myReplace = Application.InputBox("置換文字列は？", "シート名置換", Type:=2)
     
    For Each ws In ActiveWorkbook.Worksheets
        On Error Resume Next
        ws.Name = Replace(ws.Name, myFind, myReplace, 1, -1, 2)
    Next ws
End Sub