Excel VBA多文件保存问题：新建文件夹无法正确存放生成的文件

嗨，我来帮你排查这个问题～你遇到的情况很常见，核心原因就是保存文件时没有把新建文件夹的路径和文件名拼接起来，VBA默认会把文件存在当前工作簿的根目录（和你新建的文件夹同级），而不是文件夹内部。

结合你的需求，我给你调整了代码，关键修正点都标了注释，你可以直接参考：

Sub Werkbladopslaan()

' Bestand opslaan en mappen aanmaken in @In bewerking voor alle materialen
Application.ScreenUpdating = False

Dim myName As String
Dim strDefpath As String
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim folderPath As String
Dim DateStr As String
Dim saveFileName As String

' 设置基础路径为当前工作簿所在目录（如果工作簿未保存，ThisWorkbook.Path会为空，建议先保存工作簿）
strDefpath = ThisWorkbook.Path & "\"

Set rng = Range("B11:B14")

For Each row In rng.Rows
    For Each cell In row.Cells
        If cell.Value > 0 Then
            DateStr = Format(Date, "dd-mm-yyyy")
            ' 定义文件名和文件夹名（你可以根据需求分开设置不同名称）
            saveFileName = cell.Text & "-" & "Leish " & DateStr
            cell.Offset(0, 3).Value = saveFileName
            
            ' 构建要创建的文件夹的完整路径
            folderPath = strDefpath & saveFileName
            
            ' 检查文件夹是否存在，不存在则创建
            If Dir(folderPath, vbDirectory) = "" Then
                MkDir folderPath
            End If
            
            ' 保存工作簿副本到新建文件夹，必须拼接完整路径+文件名+后缀
            ' 后缀根据你的文件类型调整：.xlsm（带宏）/.xlsx（无宏）/.xls（旧格式）
            ThisWorkbook.SaveCopyAs folderPath & "\" & saveFileName & ".xlsm"
        End If
    Next cell
Next row

Application.ScreenUpdating = True
MsgBox "所有文件已保存完成！", vbInformation

End Sub

另外给你提几个小提醒：

• 如果你的工作簿还没手动保存过，ThisWorkbook.Path会返回空值，创建文件夹会报错，建议先保存一次工作簿，或者在代码里加判断提示用户先保存。
• 文件夹和文件名里别用Windows禁止的特殊字符（比如\ / : * ? " < > |），如果单元格内容可能包含这些字符，可以在代码里加替换处理，比如把特殊字符换成下划线。
• 一定要匹配正确的文件后缀，比如你的文件是带宏的，就用.xlsm，否则保存后宏会丢失。

备注：内容来源于stack exchange，提问作者Caroline