复制多个表格并重命名

雨天花心

需求是复制已经存在的Sheet1如图所示的Sheet，按照D2的月份，复制一个月的，每个Sheet的名称按照日期来命名，同时A3单元格里填充当天的日期。

自己刚学VBA，编写的只能实现复制表格，但无法实现日期修改和名称修改……特请教、学习！

凌空一羽

Sub lkyy()
Dim sh As Byte
Application.DisplayAlerts = False
sh = Sheets.Count
If sh > 1 Then
For i = sh To 2 Step -1
    Sheets(i).Delete
Next
End If
date_day = Day(DateSerial(Year(Date), Month(Date) + 1, 1) - 1)
For i = 2 To date_day
    Sheet1.Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .[a3] = DateSerial(Year(Date), Month(Date), i)
        .[d2] = DateSerial(Year(Date), Month(Date), i)
        .Name = Month(Date) & "月" & i & "日"
    End With
Next
Sheet1.Name = Month(Date) & "月1日"
Application.DisplayAlerts = True
End Sub

jmtang

好像是录制的宏可以实现吧

雨天花心

凌空一羽 发表于 2020-2-4 17:03
Sub lkyy()
Dim sh As Byte
Application.DisplayAlerts = False

感谢，可以实现，学习中~