​マクロメモ

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 "H:\tanaoroshi\Book2.xlsx"
        Worksheets("FUMIO1").Range("A1:A18").Copy Worksheets("ZFT1").Range("F2")
        Worksheets("RUKY1").Range("A1:A18").Copy Worksheets("ZLY1").Range("F2")
        Worksheets("RESIO1").Range("A1:A18").Copy Worksheets("ZEC1").Range("F2")
        Worksheets("YUMI1").Range("A1:A18").Copy Worksheets("ZEB1").Range("F2")
        Worksheets("MAMI2").Range("A1:A18").Copy Worksheets("ZEB2").Range("F2")
        Worksheets("IMEJI1").Range("A1:A18").Copy Worksheets("YMO1").Range("F2")
        Worksheets("YMO1").Range("A1:A18").Copy Worksheets("YMI1").Range("F2")
        Worksheets("QQQ1").Range("A1:A18").Copy Worksheets("QQQ1").Range("F2")
            'エラー確認
            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