根據Excel一覽中的內容，自動生成一覽名字中Sheet頁

'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
'*                                    　　　　　　　　　  *
'* Out対象の全員シート作成　　                            *
'* 作成日：2017/08/13                                     *
'* 作成者：sun      　　　　　　　　　                    *
'* 更新日：2017/08/13  　　　　　　　　                   *
'* 更新者：sun     　　　　　　　　　　                   *
'*                                                        *
'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
Public Sub createOutFileAllSheets(outWb As Workbook)

    On Error GoTo errl
    
    '★★★Operate Out ファイル step1　start★★★
    outWb.Activate
    outWb.Sheets("LIST").Select
    
    Dim peopleName As String
    Dim peopleNumber As String
    
    For i = 3 To 100
    
        outWb.Sheets("LIST").Select
        peopleName = Cells(i, 3).Value
        peopleNumber = Cells(i, 2).Value
        
        
        If peopleName = Empty Then
            Exit For
        End If
      
        Sheets("000").Copy After:=Sheets(2 + (i - 3))
        Sheets("000 (2)").Name = peopleNumber
        Sheets(peopleNumber).Select
        Range("C3").Value = peopleName
        
        'KEY:peopleName, Value:peopleNumber
        peopleInfo.Add peopleName, peopleNumber
        
    Next
    
    Sheets("000").Select
    ActiveWindow.SelectedSheets.Delete
    '★★★Operate Out ファイル step1　end★★★
    
     GoTo endok
errl:
    '異常処理
     ERROR_FLG = "1"
     ERROR_INFO_LIST.Add ("関數「createOutFileAllSheets」で、エラー発生しました。")
     ERROR_INFO_LIST.Add ("エラー詳細：" & Err.Number & " ： " & Err.Description)
endok:


End Sub
 

呼叫元相關

             'IN対象ファイル
             Dim wbIn As Workbook
             'IN対象ファイル、File毎にOpen
             Application.DisplayAlerts = False
             Set wbIn = Workbooks.Open(IN_FILE_PATH & "\" & IN_FILE1_NAME, UpdateLinks:=0, ReadOnly:=True)

程式碼