我正在尝试创建一个文件夹,并将工作簿的副本保存在此文件夹中,其中包含工作簿 B11-B14 范围内的所有已填充单元格。我设法创建了具有正确名称和日期的文件夹和文件,但文件未放置在新创建的文件夹中。它与我新创建的文件夹位于同一目录中。不知道如何更正它。任何帮助都将不胜感激。
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
Set rng = Range("B11:B14")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.Value > 0 Then
Dim Name As String
DateStr = Format(Date, "dd-mm-yyyy")
Name = cell.Offset(0, 0).Text & "-" & "Leish " & DateStr
cell.Offset(0, 3).Value = Name
startPath = "N:\Sequence resultaten\@In bewerking\"
myName = cell.Offset(0, 3).Text
ActiveWorkbook.SaveCopyAs Filename:=startPath & myName & ".xlsm"
Dim folderPathWithName As String
folderPathWithName = startPath & Application.PathSeparator & myName
If Dir(folderPathWithName, vbDirectory) = vbNullString Then
MkDir folderPathWithName
Else
MsgBox "Map bestaat al"
On Error Resume Next
End If
Worksheets("Monsterlijst").Range("D11:E14").Clear
Worksheets("Monsterlijst").Range("C3").Select
Else
End If
Next cell
Next row
Application.ScreenUpdating = True
End Sub