每次都要重新输入数字,错误的地方才会改正,自己不会VBA,这个是用的GPT,下面是代码,麻烦会的老师,改了把完整的代码发一下谢谢。或者加我WEI有偿感谢
Sub 复制工作表重要()
Dim i As Integer
Dim num As Integer
Dim lastReport As String
Dim lastRecord As String
lastReport = "报告"
lastRecord = "记录"
num = InputBox("请输入要复制的数量:", "复制工作表")
For i = 1 To num
If i = 1 Then
'第一次复制直接复制现有的报告和记录
Sheets(Array(lastReport, lastRecord)).Copy after:=Sheets(Sheets.Count)
Else
'在之后的复制中判断是否需要重新复制最后的报告和记录
If Sheets(lastReport).Name <> "报告" Or Sheets(lastRecord).Name <> "记录" Then
Sheets(Array(lastReport, lastRecord)).Copy after:=Sheets(Sheets.Count)
lastReport = Sheets(Sheets.Count - 1).Name
lastRecord = Sheets(Sheets.Count).Name
Else
Sheets(Array(lastReport, lastRecord)).Copy after:=Sheets(Sheets.Count)
lastReport = Sheets(Sheets.Count - 1).Name
lastRecord = Sheets(Sheets.Count).Name
End If
End If
'提取工作表名称的阿拉伯数字到CE4单元格中
Dim sheetName As String
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "[0-9]+"
sheetName = ActiveSheet.Name
If regEx.Test(sheetName) Then
Dim numMatch As Object
Set numMatch = regEx.Execute(sheetName)
Range("CE4").Value = numMatch(0)
Else
Range("CE4").Value = ""
End If
Next i
End Sub