title: Save excel Workbook in a new created folder with the Same names
body: <p>I found this code and it should create a new folder and should save the file in it.<br>
  Problem here the code doesn't work...</p>
  
  <p>The code I found should create a folder in the code written path but i want that it creates the folder and the new sheets in the same path as the workbook now is. i don't know how I can bin this in "thisWb.Path"</p>
  
  <p>Original code i found</p>
  
  <pre><code>Sub Macro1()
  Dim strFilename, strDirname, strPathname, strDefpath As String
  On Error Resume Next ' If directory exist goto next line
  strDirname = Range("A1").Value ' New directory name
  
  strFilename = Range("A2").Value 'New file name
  strDefpath = "C:\My Documents\" 'Default path name
  If IsEmpty(strDirname) Then Exit Sub
  If IsEmpty(strFilename) Then Exit Sub
  
  MkDir strDefpath &amp; strDirname
  strPathname = strDefpath &amp; strDirname &amp; "\" &amp; strFilename 'create total string
  
  ActiveWorkbook.SaveAs FileName:=strPathname, _
  FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  ReadOnlyRecommended:=False, CreateBackup:=False
  End Sub
  </code></pre>
  
  <p>"The idea is That it wokrs like a templete ypu fill your stuff in the form and press the button and it saves the file(only the one sheet in .xls) in a new Folder(both same names, like 1102) for you"</p>
  
  <hr>
  
  <p>But i still have no clue how i only can save one sheet so the file with the macro in works like a template and can save the forms to the freshly created folders. like a copy. so that i can continue working in my file with the macro..</p>
  
  <p>Code that works! thanks to @Balinti</p>
  
  <pre><code>Sub Macro1()
  Dim strFilename, strDirname, strPathname, strDefpath As String
  On Error Resume Next ' If directory exist goto next line
  strDirname = Range("D81").Value ' New directory name
  
  strFilename = Range("D8").Value 'New file name
  strDefpath = Application.ActiveWorkbook.Path 'Default path name
  If IsEmpty(strDirname) Then Exit Sub
  If IsEmpty(strFilename) Then Exit Sub
  
  MkDir strDefpath &amp; "\" &amp; strDirname
  strPathname = strDefpath &amp; "\" &amp; strDirname &amp; "\" &amp; strFilename 'create total string
  
  ActiveWorkbook.SaveAs Filename:=strPathname &amp; ".xlsm", _
  FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
  ReadOnlyRecommended:=False, CreateBackup:=False
  End Sub
  </code></pre>