Excel Forum

Code: Select all

Sub MakeMyFolder()

    Dim path As String, DocName As String
    Dim fdObj As Object
    Dim mybook As Workbook
    Set wksht = ActiveSheet
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set fdObj = CreateObject("Scripting.FileSystemObject")
    If fdObj.FolderExists("C:\Cost_Report\") Then
    Else
        fdObj.CreateFolder ("C:\Cost_Report\")
    End If
    
    path = "C:\Cost_Report"
    DocName = "Report"
    If Dir(path & "\" & DocName & ".xlsx") = "" Then
       Workbooks.Add
       ActiveWorkbook.SaveAs path & "\" & DocName & ".xlsx"
    End If

      Workbooks.Open "C:\Cost_Report\Report.xlsx"
      Workbooks("copymoney.xlsm").Worksheets("cost").Range("A3:Y3").Copy
      Workbooks("Report.xlsx").Worksheets("sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
      
      ActiveSheet.Name = ActiveSheet.Range("A1").Value
      ActiveWorkbook.SaveAs Filename:=path & wksht.Range("A3").Value & ".xlsx"
      'ActiveWorkbook.Worksheets("Report").Name = Worksheets("Report").Range("A3").Value
      
      Worksheets("Report").Name = Worksheets("Report").Range("A1").Value
      ActiveWorkbook.Close SaveChanges:=True
      Application.DisplayAlerts = True
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub