大家好，我是捌贰春秋VBA。在平常工作中，我们要备份工作表部分内容，需保存到另外一个工作簿。
今天给大家带来一段实用代码，功能如下：
1、新建文件夹：如改文件路径下没有“销售单备份”文件夹，则新建；已存在，则不新建。
2、新建工作簿：遍历“销售单备份”文件夹，如2024年03月工作簿（举例）不存在，则新建；已存在，则不新建。
3、复制粘贴指定单元格内容：若2024年03月工作簿（举例）不存在，则新建工作簿之后，将内容粘贴到第一个工作表；若2024年03月工作簿（举例）已存在，则将内容粘贴到改工作簿最后一个工作表。
'/// 功能：将销售单按日期备份到另外工作簿，并清空销售单；每个月一张工作簿
Private Sub CommandButton3_Click()
On Error Resume Next
If MsgBox("是否导出为文件？" & vbCrLf & vbCrLf & "本页销售单将被清除，请确认已处理完毕！", vbYesNo) = vbNo Then Exit Sub
Dim ws As Worksheet
Dim rng As Range
Dim newWorkbook As Workbook
Dim savePath As String
Dim folderPath As String, fldr As String, fileName As String, wsName As String
Dim workbookExists As Boolean, wb As Workbook
'判断文件夹”销售单备份“是否存在，不存在则新建
folderPath = ThisWorkbook.Path & "\销售单备份"
fldr = Dir(folderPath, vbDirectory)
If fldr = "" Then
MkDir folderPath
End If
'工作簿名称：2024年3月 工作簿名称：18日
Dim x As String, y As String, z As String
x = CStr(Format([G3].Value, "yyyy"))
y = CStr(Format([G3].Value, "mm"))
z = CStr(Format([G3].Value, "dd"))
'文件名：2024年3月
fileName = x & "年" & y & "月" & ".xlsx"
'新表名称：18日
wsName = z & "日"
' 文件完整路径
savePath = folderPath & "\" & fileName
' 设置引用的工作表和范围
Set ws = ThisWorkbook.Sheets("销售单") ' 工作表名
Set rng = ws.UsedRange ' 要保存的单元格区域
' 使用Dir函数检查工作簿是否存在
If Dir(savePath) <> "" Then '工作簿存在则新增工作表
workbookExists = True
Set wb = Workbooks.Open(savePath)
' 添加新工作表
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = wsName ' 新建工作表名称
' 复制指定范围的内容到新工作簿的第一个工作表
rng.Copy Destination:=wb.Sheets(ws.Name).Range("A1")
' 保存工作簿
wb.Save
' 关闭新工作簿
wb.Close SaveChanges:=False
Else
workbookExists = False
' 创建新的工作簿
Set wb = Workbooks.Add
' 复制指定范围的内容到新工作簿的第一个工作表
rng.Copy Destination:=wb.Sheets(1).Range("A1")
wb.Sheets(1).Name = wsName
' 保存新工作簿
wb.SaveAs fileName:=savePath
' 关闭新工作簿
wb.Close SaveChanges:=False
End If
' 清空销售单，保存当前文件
ws.UsedRange.Clear
ThisWorkbook.Save
End Sub