Results 1 to 3 of 3

Code Creating new folder with predetermined filename

Threaded View

  1. #1
    Registered User
    Join Date
    05-02-2012
    Location
    Indiana
    MS-Off Ver
    Excel 2007
    Posts
    33

    Code Creating new folder with predetermined filename

    Hello,
    I am in need of a code to create a new folder. I have the code to rename the folder to a specific name (issue number).

    There are several small things in my code I am not happy with and could use some help.
    Your help is greatly appreciated.

    My (ICAR)workbook contains several sheets.
    As the first worksheet (Report) is filled in, it is linked to the others, populating some of the criteria as needed.
    When every sheet is completed as necessary, a code will make a copy of each sheet, save each as a new book in a specific folder, change the formulas to values, and close out. It then opens a log, log the information on the Report on the original workbook, saves the log, closes this out. Then at last it closes out the ICAR workbook.

    The changes I would like to make are as follows:
    -Update links: none there should be no links once I changed all the formulas to values for each saved worksheet
    -When I save the worksheets individially, the "macro buttons" are saved with them - can I remove them - every time
    - Set rngDetailFound = rngDetailToSearch.Find(What:=wks.Range("IV50000"), _ LookAt:=xlPart, MatchCase:=False) - ALL i want it to find is the next empty cell, I had to eventually reference a cell that I knew would be blank -
    - When one of the sheets I save has a filename beginning with the word "No", then I do not want it to save a copy in the folder.
    And at the very end, I do not want the user to be able to save any changes to the ICAR report workbook before closing out - all the sheets are saved and logged already and this workbook needs to star clear for the next user.

    Here id the code I have so far:
    Sub LogDataLog()
    'Log Entries of Investigation Details in ICAR log, Save and Close Log
     Workbooks.Open Filename:="G:\ICAR\I CAR LOG.xlsm", UpdateLinks:=3
    
        Sheets("Reject_Log_Database").Select
            Dim myDetailFind As Integer
    Dim rngDetail As Range
    Dim rngDetailToSearch As Range
    Dim rngDetailFound    As Range
    Set wks = ActiveSheet
    Set rngDetailToSearch = ActiveSheet.Range("A6:A20000")
    Set rngDetailFound = rngDetailToSearch.Find(What:=wks.Range("IV50000"), _
             LookAt:=xlPart, MatchCase:=False)
    
    ActiveSheet.Range("A2:AT2").Copy
       rngDetailFound.Offset(0, 0).PasteSpecial xlValues
        Application.CutCopyMode = False
      ActiveWorkbook.Save
      ActiveWorkbook.Close
        
       'Make copy of Quality Alert and place in Quality Alert Folder
        Sheets("Quality Alert").Visible = True
        Sheets("Quality Alert").Select
        Sheets("Quality Alert").Copy
            strFileName = Range("BB1").Text
    ActiveWorkbook.SaveAs Filename:="G:\ICAR\ICAR QualityAlert\" & strFileName & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveWorkbook.Save
            ActiveWorkbook.Close
            'Windows("I CAR _REPORT.xlms").Activate
            
            'Make copy of Containment Worksheet and place in Containment Worksheet Folder
            Sheets("Containment Worksheet").Visible = True
             Sheets("Containment Worksheet").Visible = True
        Sheets("Containment Worksheet").Select
        
        Sheets("Containment Worksheet").Copy
            strFileName = Range("BB1").Text
    ActiveWorkbook.SaveAs Filename:="G:\ICAR\ICAR Containment\" & strFileName & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveWorkbook.Save
            ActiveWorkbook.Close
             'Windows("I CAR _REPORT.xlms").Activate
            
           'Make copy of 8D and place in 8D Folder
            Sheets("8D Report").Visible = True
            Sheets("8D Report").Visible = True
        Sheets("8D Report").Select
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Sheets("8D Report").Copy
            strFileName = Range("BB1").Text
    ActiveWorkbook.SaveAs Filename:="G:\ICAR\ICAR 8D\" & strFileName & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveWorkbook.Save
            ActiveWorkbook.Close
             'Windows("I CAR _REPORT.xlms").Activate
            
           'Make copy of PPSR 1 and place in PPSR1 Folder
           Sheets("PPSR 1").Visible = True
            Sheets("PPSR 1").Visible = True
        Sheets("PPSR 1").Select
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Sheets("PPSR 1").Copy
            strFileName = Range("BB1").Text
    ActiveWorkbook.SaveAs Filename:="G:\ICAR\ICAR PPSR 1\" & strFileName & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveWorkbook.Save
            ActiveWorkbook.Close
            'Windows("I CAR _REPORT.xlms").Activate
            
            
        'Make copy of PPSR 2 and place in PPSR2 Folder
            Sheets("PPSR 2").Visible = True
            Sheets("PPSR 2").Visible = True
        Sheets("PPSR 2").Select
        
        Sheets("PPSR 2").Copy
            strFileName = Range("BB1").Text
    ActiveWorkbook.SaveAs Filename:="G:\ICAR\ICAR PPSR 2\" & strFileName & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
         ActiveWorkbook.Save
            ActiveWorkbook.Close
           Sheets("Tips").Visible = True
            Sheets("Tips").Visible = True
        Sheets("Tips").Select
       Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Sheets("Tips").Copy
            strFileName = Range("BB1").Text
    ActiveWorkbook.SaveAs Filename:="G:\ICAR\ICAR Tips\" & strFileName & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            ActiveWorkbook.Close
    THANK YOU FOR ANY HELP
    Last edited by arlu1201; 06-18-2012 at 10:55 AM. Reason: Code tags.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1