Sub 二上寄せ()
    '選択可能ファイルのフィルターを設定
    Const C_FILEFILTER As String = "Excelファイル,*.xlsx;*.xls"
    '開いているブック数が2つ以上の場合は終了
    If 1 < Workbooks.Count Then
        MsgBox "このブック以外のExcelファイルを閉じてください", _
               vbExclamation, _
               "終了します"
        Exit Sub
    End If
    'ファイルの選択
    Dim varFilesName As Variant
    varFilesName = Application.GetOpenFilename(C_FILEFILTER, , _
                                               "ファイルを1つだけ選択してください", , _
                                               False)
    
    'キャンセルを選択した場合は終了
    If VarType(varFilesName) = vbBoolean Then Exit Sub
    
    Workbooks.Open "F:\takanashi\Book1.xlsx"
    WorkSheets("DAZN-FFF1").Select
    Range("A1").Select
    Selection.ClearContents
    Range("A2:A79").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "FFF1"
    WorkSheets("DAZN-EEE1").Select
    Selection.ClearContents
    Range("A2:A12").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "EEE1"
    WorkSheets("DAZN-EEE2").Select
    Selection.ClearContents
    Range("A2:A12").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "EEE2"
    WorkSheets("DAZN-TEC1").Select
    Selection.ClearContents
    Range("A2:A12").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "TEC1"
    WorkSheets("DAZN-TRY1").Select
    Selection.ClearContents
    Range("A2:A12").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "TRY1"
    WorkSheets("DAZN-QQQ1").Select
    Selection.ClearContents
    Range("A2:A12").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "QQQ1"
    WorkSheets("DAZN-III1").Select
    Selection.ClearContents
    Range("A2:A12").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "III1"
    WorkSheets("DAZN-YMO1").Select
    Selection.ClearContents
    Range("A2:A12").Select
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Name = "YMO1"
            'エラー確認
            If Err.Number = 0 Then
                lngCount = lngCount + 1
    '終了メッセージ
    If lngErrCount = 0 Then
        MsgBox "ありがとうございました", _
               vbInformation, _
               "終了しました"
    Else
        MsgBox "エラーになったファイルがあります" & vbLf & vbLf & Join$(strErrFiles, vbLf), _
               vbExclamation, _
               "終了しました"
    End If
    End If
End Sub