Select folder, unformat & clean up certain sheets within workbooks & consolidate those certain sheets into a single workbook

[griff78]

All be it long, ugly and full of redundancies, I am usually able to Frankenstein something together based on what you all have previously provided but I cant seem to find exactly what I need for this one. I have strings to perform most of the needed actions individually and some combined but haven't been successful in combining them all into a single cleaned up version that gets me where I need to be.

Here's the run down: We have folders for each project. Each project folder then contains folders for Cost, Meetings, Plans, etc. The Plans folder contains a workbook for each plan. Each workbook has 2-5 sheets that are inconsistently named. At least one sheet name in each workbook contains but does not always equal "Step Out", "Plan", or "Scope". All of these sheets contain the same general info but each is slightly different depending on where they came from. (Step Out has project name in b1, Plan has project name in c3, Scope has project name in a2). Standardizing and consolidating the data from these sheets into a single sheet is the end goal. Once all sheets are consolidated into a single sheet, that single sheet is imported into another system for reporting.

Looking to be able to select a folder with multiple workbooks, unformat and clean up certain sheets within those workbooks and copy those certain sheets into a single workbook.

Would it be possible to have a one and done to get through 1 to 10? I would believe there are too many scenarios to automate 11

I'm pretty sure its possible but I only know enough to copy, paste, slightly modify as needed and run it. If it bugs out on me, I undo whatever I changed and try something else until I get to something better than what I started with.

Current process:

1. Scroll through the folder to ensure each workbook contains at least one sheet containing "Step Out, "Plan" or "Scope".
2. Select a folder and unhide all sheets in all workbooks within selected folder with:
   • Sub LoopAllExcelFilesInFolder3()
     'PURPOSE: To loop through all Excel files in a user specified folder and unhides all hidden sheets
     
     Dim wb As Workbook
     Dim myPath As String
     Dim myFile As String
     Dim myExtension As String
     Dim FldrPicker As FileDialog
     
     'Optimize Macro Speed
     Application.ScreenUpdating = False
     Application.EnableEvents = False
     Application.Calculation = xlCalculationManual
     
     'Retrieve Target Folder Path From User
     Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
     
     With FldrPicker
     .Title = "Select A Target Folder"
     .AllowMultiSelect = False
     If .Show <> -1 Then GoTo NextCode
     myPath = .SelectedItems(1) & "\"
     End With
     
     'In Case of Cancel
     NextCode:
     myPath = myPath
     If myPath = "" Then GoTo ResetSettings
     
     'Target File Extension (must include wildcard "*")
     myExtension = "*.xls*"
     
     'Target Path with Ending Extention
     myFile = Dir(myPath & myExtension)
     
     'Loop through each Excel file in folder
     Do While myFile <> ""
     'Set variable equal to opened workbook
     Set wb = Workbooks.Open(FileName:=myPath & myFile)
     
     'Ensure Workbook has opened before moving on to next line of code
     DoEvents
     
     'UnhideAllSheets()
     Dim ws As Worksheet
     
     For Each ws In ActiveWorkbook.Worksheets
     ws.Visible = xlSheetVisible
     Next ws
     
     Application.DisplayAlerts = True
     
     'Save and Close Workbook
     wb.Close SaveChanges:=True
     
     'Ensure Workbook has closed before moving on to next line of code
     DoEvents
     
     'Get next file name
     myFile = Dir
     Loop
     
     'Message Box when tasks are completed
     MsgBox "Scope Formatting Complete!"
     
     ResetSettings:
     'Reset Macro Optimization Settings
     Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True
     
     End Sub
3. Combine all sheets from all workbooks within selected folder with:
   • Sub CombineFiles()
     Dim path As String
     Dim FileName As String
     Dim LastCell As Range
     Dim Wkb As Workbook
     Dim ws As Worksheet
     Dim ThisWB As String
     
     ThisWB = ThisWorkbook.Name
     Application.EnableEvents = False
     Application.ScreenUpdating = False
     path = GetDirectory
     'Update file type as needed
     FileName = Dir(path & "\*.xlsx", vbNormal)
     Do Until FileName = ""
     If FileName <> ThisWB Then
     Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
     For Each ws In Wkb.Worksheets
     Set LastCell = ws.Cells.SpecialCells(xlCellTypeLastCell)
     If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
     Else
     ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
     End If
     Next ws
     Wkb.Close False
     End If
     FileName = Dir()
     Loop
     Application.EnableEvents = True
     Application.ScreenUpdating = True
     
     Set Wkb = Nothing
     Set LastCell = Nothing
     End Sub
4. Remove all conditional formatting
5. Delete all sheets that do not contain "Step Out, "Plan" or "Scope" with:
   • Sub Delete_Unused_Sheets()
     Dim ws As Worksheet
     For Each ws In ThisWorkbook.Sheets
     'Change name and re-run as needed
     If ws.Name Like "Sheet2" & "*" Then
     '~~> This check is required to ensure that you don't get an error
     '~~> if there is only one sheet left and it matches the delete criteria
     If ThisWorkbook.Sheets.Count = 1 Then
     MsgBox "You cannot delete the last sheet"
     Else
     '~~> This is required to supress the dialog box which excel shows
     '~~> When you delete a sheet. Remove it if you want to see the
     '~~~> Dialog Box
     Application.DisplayAlerts = False
     ws.Delete
     Application.DisplayAlerts = True
     End If
     End If
     Next
     End Sub
6. Select all sheets, unmerge all merged cells, unhide all hidden columns and rows, remove all borders and formatting, copy and paste all data as values to remove formulas
7. Remove pics and objects with:
   • Sub DeletePictures()
     Dim oPic As Shape
     Dim wb As Workbook
     Dim ws As Worksheet
     'Loop through all worksheets
     For Each ws In ThisWorkbook.Worksheets
     If ws.Name Like "Package" & "*" Then
     'Loop through all objects in the selected worksheet
     For Each oPic In ws.Shapes
     'Delete object
     oPic.Delete
     Next oPic
     End If
     Next ws
     End Sub
8. Remove frozen views with:
   • Sub UnFreeze()
     'Updateby Extendoffice
     Dim ws As Worksheet
     Application.ScreenUpdating = False
     For Each ws In Application.ActiveWorkbook.Worksheets
     ws.Activate
     With Application.ActiveWindow
     .FreezePanes = False
     End With
     Next
     Application.ScreenUpdating = True
     End Sub
9. Remove links with:
   • Sub BreakExternalLinks()
     'PURPOSE: Breaks all external links that would show up in Excel's "Edit Links" Dialog Box
     
     Dim ExternalLinks As Variant
     Dim x As Long
     Dim BreakCounter As Long
     
     'Create an Array of all External Links stored in Workbook
     ExternalLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
     If IsEmpty(ExternalLinks) = True Then GoTo ReportResults
     
     'Loop Through each External Link in ActiveWorkbook and Break it
     For x = 1 To UBound(ExternalLinks)
     ActiveWorkbook.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
     BreakCounter = BreakCounter + 1
     Next x
     
     'Report to User how many External Links were Broken
     ReportResults:
     MsgBox "External Links Broken: " & BreakCounter
     
     End Sub
10. Remove all data validation
11. Select matching sheets and adjust grouped sheets as required to standardize
12. Combine all sheets to master sheet with:
    • Sub Worksheet_Activate()
      Dim Sheet As Worksheet
      For Each Sheet In Me.Parent.Sheets
      If Sheet.Name <> Me.Name Then
      If Sheet.Cells(Rows.Count, 1).End(xlUp).Row <> 1 Then
      Sheet.Range(Sheet.Cells(1, 1), Sheet.Cells(Sheet.Cells(Rows.Count, 1).End(xlUp).Row, 22)).Copy Destination:=Me.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
      
      End If
      Else
      Me.Range(Cells(2, 1), Cells(Rows.Count, 22)).Clear
      End If
      Next Sheet
      End Sub
13. Delete all sheets except consolidated master sheet.