Dim phn As String
Dim phna As String
Dim phnb As String
Dim i As Integer

Sub ki040()
'保存先パス
phna = ActiveWorkbook.Path
     If phna = "" Then
         MsgBox "このブックと同じフォルダ−へ保存します" & Chr(10) _
        & "パス未定の為ブックを1度保存してから実行して下さい"
        Exit Sub
     End If
If phn = "" Then
   phn = phna
End If
'フォルダ−チェック
    If Dir(phn & "\Myfile" & "\*") = "" Then
       MkDir phn & "\Myfile"
    End If
  dai = ActiveWorkbook.Name
  dai = i & "_" & dai
  i = i + 1
  phnb = phn & "\Myfile\"
  
  ActiveWorkbook.SaveAs Filename:=phnb & dai, FileFormat:=xlNormal _
           , Password:="", WriteResPassword:="", ReadOnlyRecommended _
           :=False, CreateBackup:=False

End Sub