代码再次运行有问题，求指教！！！

七彩菠萝爆炸鸡

代码1：先运行这段代码将文件保存到指定文件夹内

Private Sub CommandButton21_Click()
Dim AA, BB
Application.DisplayAlerts = False
AA = "C:\Users\Administrator\Desktop\XXX\" & Format(Date, "YYYY-MM-DD") & "\YYY\"
BB = [K3]
ThisWorkbook.SaveAs AA & BB & ".xlsm"
Application.DisplayAlerts = True
End Sub

代码2：再运行下面的代码，将其他表格移动到正在工作的excel上：

Workbooks.Open Filename:="C:\Users\Administrator\Desktop\ZZZ.xlsm" '打开表格代码

Windows("ZZZ.xlsm").Activate '转移工作簿代码
Sheets("Sheet1").Select
Sheets("Sheet1").Move Before:=Workbooks(ThisWorkbook.Name).Sheets(1)

'Windows("ZZZ.xlsm").Activate '表格关闭不保存
'ActiveWindow.Close SaveChanges:=False
End Sub

但是再点击命名按钮运行代码1时，出现下面的问题导致无法保存，求指教！

七彩菠萝爆炸鸡

前面的的能用，但是启用这两段代码就不行了
Windows("ZZZ.xlsm").Activate '表格关闭不保存
ActiveWindow.Close SaveChanges:=False

代码1：先运行这段代码将文件保存到指定文件夹内

Private Sub CommandButton21_Click()
Dim AA, BB
Application.DisplayAlerts = False
AA = "C:\Users\Administrator\Desktop\XXX\" & Format(Date, "YYYY-MM-DD") & "\YYY\"
BB = [K3]
ThisWorkbook.SaveAs AA & BB & ".xlsm"
Application.DisplayAlerts = True
End Sub

代码2：再运行下面的代码，将其他表格移动到正在工作的excel上：

Workbooks.Open Filename:="C:\Users\Administrator\Desktop\ZZZ.xlsm" '打开表格代码

Windows("ZZZ.xlsm").Activate '转移工作簿代码
Sheets("Sheet1").Select
Sheets("Sheet1").Move Before:=Workbooks(ThisWorkbook.Name).Sheets(1)

Windows("ZZZ.xlsm").Activate '表格关闭不保存
ActiveWindow.Close SaveChanges:=False
End Sub

但是再点击命名按钮运行代码1时，出现下面的问题导致无法保存，求指教

leirongqin

说再多，上附件   给论坛老师测试看看比较实在

ykcbf1100

没有附件，没人看你那代码的。

七彩菠萝爆炸鸡

附上测试附件

执行以下操作：
1、数据工作的AB表格打开，单元格K3和K4都输入1，点绿色的保存
2、点击Sheet2里面的“AB“”按键，然后在单元格K3输入1，K4都输入2，再点绿色的保存

问题：最后再点击保存就不行了

七彩菠萝爆炸鸡

七彩菠萝爆炸鸡 发表于 2022-12-14 16:54
附上测试附件

执行以下操作：

求各位老师指点一下

leirongqin

七彩菠萝爆炸鸡 发表于 2022-12-14 16:54
附上测试附件

执行以下操作：

Private Sub CommandButton21_Click()
    Dim AA, AB, BB
    Application.DisplayAlerts = False
    AA = "D:\迅雷下载\测试\数据抓取\" & Format(Date, "YYYY-MM-DD") '文件地址你自己赶紧实际修改一下
    AB = "\YYY\"
    BB = [K3]
    If Dir(AA, vbDirectory) = "" Then '判断文件夹是否存在
        MkDir (AA) '创建文件夹
    End If
    If Dir(AA & AB, vbDirectory) = "" Then '判断文件夹是否存在
        MkDir (AA & AB) '创建文件夹
    End If
    ThisWorkbook.SaveAs AA & AB & BB & ".xlsm"
    Application.DisplayAlerts = True
End Sub

你自己修改一下[CommandButton21]代码吧，我测试没问题