한 책의 범위를 다른 책의 지정된 위치에 복사합니다.

이번에는 지난 번 작성했습니다.
전기하고 싶은 시트 & 북명의 이름이나 수가 바뀌어도 움직이도록 개수한 매크로
「같은 폴더내에 있는 「○○리스트.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」의 경우로 처리를 지정할 수 있는 것이 이렇게 편리하다고는 몰랐습니다!

일단 이 매크로의 개수는 여기에서 종료해, 잠시 공부해 힘이 붙고 나서 전체적으로 가독성이 높은 코드에 조정을 해 나가고 싶습니다.

다음 번에
"동일한 폴더에 있는 여러 파일의 내용 지정 범위를 통합하여 새 파일에 저장"
매크로를 만듭니다.