あるブックの任意の範囲を別のブックの指定した箇所にコピペする その4

今回は、前回作成した
転記したいシート＆ブック名の名前や数が変わっても動くように改修したマクロ
『同じフォルダ内にある「○○一覧.xlsx」の任意のシート内容をそれぞれ別のファイルに転記する』
を分岐を作って、転記ができない場合にメッセージが出るように改修しました。

メッセージを出す時の分岐点ですが、以下3点です。
　1.シート名を所得するために最初に参照する「セルB1」が空白ではない
　2.対象のセルの値と一致するシート名が存在する
　3.マクロファイルがあるフォルダー内に、対象のシート名と一致するブック（シート名YYMMDD.xlsx）が存在する
判定1
判定2
判定3

これらをすべてクリアしたら、転記を始まるようにしました。
（クリアしなかったら、それぞれメッセージボックスを出してマクロを終了します）

Sub tenki3()

'判定1
'セルB1（取得するシート名）の値が空白か判定→空白でなければ次へ進む。なければマクロ終了
    If Cells(1, 2).Value = "" Then
        MsgBox "ブック＆シート名が空白です"
        Exit Sub
    Else
    
'転記用のブック＆シート名をコピーする　※ブック名は「シート名YYMMDD」とする
        Cells(1, 1).Activate
        ActiveSheet.UsedRange.Copy
    
'○○一覧を開いて転記用シートを挿入し、セルA1に貼り付けする
        Workbooks.Open ThisWorkbook.Path & "\○○一覧.xlsx"
        Worksheets.Add Before:=Sheets(1)
        ActiveSheet.Name = "転記用"
        Cells(1, 1).Activate
        ActiveSheet.Paste
  
'変数の宣言
        Dim i As Long
        Dim maxSheetCount As Long
        Dim sheetName As String
        
'参照するセルの一番右の位置を確認する
        maxSheetCount = Cells(1, Columns.Count).End(xlToLeft).Column
        
'転記用シートからシート名の入っているセルを指定する
        For i = 2 To maxSheetCount
            Worksheets("転記用").Activate
            sheetName = Cells(1, i)

'判定2
'対象シートの有無を判定→一致するシートがあれば次へ進む。なければマクロ終了
            Dim ws As Worksheet
            Dim flag As Boolean
            
            For Each ws In Worksheets
                If ws.Name = sheetName Then flag = True
            Next ws
            If flag = True Then
                
            Else
                MsgBox sheetName & "シートがありません"
                Exit Sub
            End If

'判定3
'対象ファイルの有無を判定→一致するファイルがあれば次へ進む。なければマクロ終了
            Dim filepath As String
            Dim fileName As String
        
'検索対象のファイル名
            fileName = sheetName & "YYMMDD.xlsx"
   
'ファイルのパスを取得
            filepath = Dir(ThisWorkbook.Path & "\" & fileName)
  
'ファイルの存在有無を判定→一致するファイルがあれば次へ進む。なければマクロ終了
            If Len(filepath) <> 0 Then
    
            Else
                MsgBox fileName & "は存在しません"
                Exit Sub
            End If
             
'シート内容を転記する
             Worksheets("転記用").Activate
             Worksheets(sheetName).Activate
             Cells(1, 1).Activate
             Worksheets(sheetName).UsedRange.Copy
             Workbooks.Open ThisWorkbook.Path & "\" & fileName
             Worksheets("データ").Range("A1").Select
             ActiveSheet.Paste
             Range("A1").Select
             ActiveWorkbook.Save
             ActiveWindow.Close
        Next i

'○○一覧を保存せずに閉じる
        Application.DisplayAlerts = False
        ActiveWindow.Close
        Application.DisplayAlerts = True
    End If
End Sub

今回も結構力技です。
Boolean型の活用方法がいまいちわかっていなかったのですが、「True」「False」の場合で処理を指定できるのがこんなに便利とは知らなかったです！

一旦このマクロの改修はここで終了し、しばらく勉強して力がついてから全体的に可読性の高いコードへ調整をしていきたいと思います。

次回は
『同じフォルダ内にある複数のファイルの中身の指定の範囲を統合して新しいファイルに保存する』
マクロを作ります。