VBA Excel 多个文件保存在新创建的文件夹中,以单元格范围和日期中的文本命名

VBA Excel 多个文件保存在新创建的文件夹中,以单元格范围和日期中的文本命名

我正在尝试创建一个文件夹,并将工作簿的副本保存在此文件夹中,其中包含工作簿 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

相关内容