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

如下图