创建并保存工作簿

乌沙文丐

各位大神，本人需要批量创建自定义工作簿，并想把它们保存在指定文件夹中，我第一次运行代码可以完成任务，但是我再补充创建工作簿，并想将它们保存在第一次新建的文件夹里时，代码就报错，跪求大神们帮我修改一下代码，万分感谢！。代码如下：
Sub 创建并保存工作簿()
    Dim sName As String, FileName As String, ss As String, wb As Workbook, i As Integer, x As Integer, y As Integer
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
        x = InputBox("请输入开始创建公司行号")
        y = InputBox("请输入结束创建公司行号")
        sName = InputBox("请输入保存文件夹的名称")
        MkDir ThisWorkbook.Path & "\" & sName  
        On Error Resume Next
            For i = x To y
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\模板.xlsm")  
            ss = ThisWorkbook.Sheets(1).Range("G" & i).Value
            wb.SaveAs ThisWorkbook.Path & "\" & sName & "\" & ss & ".xlsm"
            wb.Sheets(1).Range("D4").Value = ThisWorkbook.Sheets(1).Range("C" & i).Value         
        wb.Save
        wb.Close
         Next i
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

闻启学

提示什么 内容  第一个可以运行 证明你代码是行的额  注意一下 文件夹 工作簿名称 是否有重复

abc123281

x = InputBox("请输入开始创建公司行号")
y = InputBox("请输入结束创建公司行号")
sName = InputBox("请输入保存文件夹的名称")
myfile = ThisWorkbook.Path & "\" & sName
If Dir(myfile, vbDirectory) = "" Then
  MkDir myfile
End If
For i = x To y

乌沙文丐

abc123281 发表于 2019-12-15 21:41
x = InputBox("请输入开始创建公司行号")
y = InputBox("请输入结束创建公司行号")
sName = InputBox("请 ...

谢谢谢谢，圆满解决了我的问题。万分感谢！