1. 软件版本：Excel 2016
2. 因并无VBA编程背景，以下代码串为使用ChapGPT逐步修改所得之最终版本。
3. 此代码运行主要目的：将所选取之指定行，向下复制额外15行，并且指定将年/月（YY
YY/MM)字段，随行数增加，一并递增年份及月份，指定由2023/10递增至2024/12（共15行
），其他填充格内容则保持不变。
https://i.imgur.com/rmxvx2M.jpg
4. 目前此最终版本能够执行出上述结果，但是当重复对不同行执行此VBA代码，执行速度
会越变越慢…到最后直接转白圈当掉了….（总共有约370行需执行此指令）…档案报销了
好几次…估计是在运行时暂存或储存了很多没必要的选取资料或回路..
5. 最终版代码如下，请大神帮忙检视问题有可能出在哪，及该如何修改此代码以解决此
问题！感谢！（请尽量以白话解释，小弟无代码背景）
Sub CopyAndFillYearMonth()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim i As Long
Dim xRng As Range
Dim NumMonths As Integer
Dim StartDate As Date
On Error Resume Next
Set xRng = Application.InputBox("Please select the range of rows to copy:"
, "Kutools for Excel", , , , , , 8)
If xRng Is Nothing Then Exit Sub
NumMonths = 15
StartDate = DateValue("2023/10/1")
xRng.Select
For i = 1 To NumMonths
xRng.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(, 4).NumberFormat = "yyyy/mm"
ActiveCell.Offset(, 4).Value = Format(StartDate, "yyyy/mm")
StartDate = DateAdd("m", 1, StartDate)
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculate
End Sub