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

如下图

QQ截图20180725142159QQ截图20180725142308QQ图片20180725142408

版权声明：本文为hdl217原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://www.cnblogs.com/hdl217/p/9365753.html