execl 宏批量复制表并重命名

Sub 创建周表()
Dim ws As Worksheet
Dim rngData As Range
Dim cell As Range

Set ws = ThisWorkbook.Sheets("Sheet1")
Set rngData = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)

For Each cell In rngData
ActiveWorkbook.Worksheets("list").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = cell.Value


Next cell

End Sub