VBA將指定Excel表數據批量生成到另一個Excel表中，每個sheet表一行數據

Sub AutoInputValNewExcel()

    Dim sh1, sh2 As Worksheet
    Dim ws1, ws2 As Workbook

    Set ws1 = Workbooks(1)
    Set ws2 = Workbooks(2)
    Set sh1 = Workbooks(1).Sheets(1)
    iRows = sh1.UsedRange.Rows.Count
    For i = 2 To iRows Step 1
        If i > ws2.Sheets.Count Then
            ws1.Sheets(2).Copy After:=ws2.Sheets(ws2.Sheets.Count)
        End If
        Set sh2 = ws2.Sheets(i)
        sh2.Name = sh1.Range("A" & i)  'sheet名稱使用 科室名稱

        sh2.Range("C2") = sh1.Cells(i, 2)  '給值B?  i為行，2為列對應B
        sh2.Range("E2") = sh1.Cells(i, 3)  
        sh2.Range("C4") = sh1.Range("D" & i)
 
    Next
       ws2.Sheets("sheet1").Delete  '刪除第一個沒有用的sheet
    MsgBox ("操作完成")
End Sub

如下圖