vba ワークシートの名前を配列から命名する 配列は別ファイル（ここでは名簿.csv）から作成する

//十分なエラーテストは実施していません　ご参考程度に

 Sub makeP_Worksheet()

Dim targetFileName, targetFileName2, myPath, mePath As String

Dim flag As Boolean

Dim mySheetName(), LastRow As Variant

Dim cnt, i, FirstRow, myCnt As Long

Dim myRange, myObj, myFind As Range

Dim wb, wb2, myPeople As String

Dim myWb As Workbook

Dim myWbCnt As Long

On Error Resume Next

Dim bk As Workbook

  For Each bk In Workbooks

    If Not (bk Is ThisWorkbook) Then

      bk.Close SaveChanges:=False

    End If

  Next

myPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1)

mePath = ThisWorkbook.Path

targetFileName = mePath & "\" & "集計.xlsx"

targetFileName2 = myPath & "\" & "名簿.csv"

Set wb = Workbooks.Open(targetFileName)

   myWbCnt = wb.Worksheets.Count

Set wb2 = Workbooks.Open(targetFileName2)

    LastRow = wb2.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

 

 

 If myWbCnt < LastRow Then

  wb.Worksheets.Add After:=Worksheets(1), Count:=LastRow

 End If

 Set myRange = Range(Cells(1, 1), Cells(LastRow, 1))

 Set myObj = myRange.Find(What:="*", SearchOrder:=xlByRows)

 If myObj Is Nothing Then

 

  Exit Sub

  

 End If

 

 wb.Worksheet(2).Name = myObj

' Debug.Print myObj & wb.Name

' Debug.Print myObj

 FirstRow = myObj

'  Debug.Print FirstRow

  

   Set myFind = myObj

   

   

 

 ReDim mySheetName(LastRow)

  mySheetName(0) = myObj

 wb.Worksheets(2).Name = mySheetName(0)

  

  

 

  i = 1

   Do

        '// 次を検索

        Set myFind = myRange.FindNext(After:=myFind)

        mySheetName(i) = myFind

'        Debug.Print myFind(i)

        wb.Worksheets(2 + i).Name = mySheetName(i)

        '// 検索不一致時はループを抜ける

        If myFind Is Nothing Then

            Exit Do

        End If

        '// 最初に検索されたセルが再検索された場合

        If myFind.Address = myObj.Address Then

            Exit Do

        End If

'        Debug.Print myFind

'        mySheetName(i) = myFind

        Debug.Print mySheetName(i)

        i = i + 1

    Loop

End Sub