Sub Button1_Click()
Dim sFolder As String
Dim sFile As String
Dim wbD As Workbook
Dim wbS As Workbook
Dim nSheet As Worksheet
Dim dSheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set wbS = ThisWorkbook
sFolder = wbS.Path & "\"
'Loop processing all files
'within masterfile folder
sFile = Dir(sFolder)
Do While sFile <> ""
ActiveSheet.DisplayPageBreaks = False
If sFile <> wbS.Name Then
Set wbD = Workbooks.Open(sFolder & sFile)
'Copying PMF list
Set nSheet = wbD.Sheets.Add(Type:=xlWorksheet)
nSheet.Name = "PMF"
wbS.Sheets("PMF").Range("A:MP").Copy Destination:=nSheet.Range("A1")
Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Copying REL Scoring list
Set nSheet = wbD.Sheets.Add(Type:=xlWorksheet)
nSheet.Name = "REL Scoring"
wbS.Sheets("REL Scoring").Range("A:MA").Copy Destination:=nSheet.Range("A1")
Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Modifying Summary
Set nSheet = wbD.Sheets("Summary")
Set dSheet = wbS.Sheets("Summary")
nSheet.Select
Range("B1:D1").UnMerge
Range("E1:Q1").Cut Destination:=Range("D1:P1")
Rows("9:9").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H8:J8").Cut Destination:=Range("H10:J10")
Range("K8:L8").Cut Destination:=Range("K10:L10")
Range("B7:G8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("M8:P8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("O3:P7").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B3:G10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("H3:N10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Range("O8:P10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("K7:L7").UnMerge
Range("B1:C1").Merge
Range("G1:H1").Merge
Range("P8:P10").Select
With Selection.Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='REL Scoring'!$A$32:$A$33"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("E3").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="0", Formula2:="999999999999"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
With dsheet
Range("B9:G10").Copy Destination:=nSheet.Range("B9")
Range("H7:L9").Copy Destination:=nSheet.Range("H7")
Range("M9:N10").Copy Destination:=nSheet.Range("M9")
Range("O8:P10").Copy Destination:=nSheet.Range("O8")
End With
Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Modifying Equipment
'Fixing data, inserting Actual sales, modifying POC Sales formula
Set nSheet = wbD.Sheets("By Equipment")
Set dSheet = wbS.Sheets("By Equipment")
nSheet.Range("E5").EntireRow.Insert
With dSheet
.Range("E2:R2").Copy Destination:=nSheet.Range("E2")
.Range("S3:S3").Copy Destination:=nSheet.Range("S3")
.Range("A5:S5").Copy Destination:=nSheet.Range("A5")
.Range("E4:S4").Copy Destination:=nSheet.Range("E4")
End With
'Modifying Total costs formula
dSheet.Range("A59:R59").Copy
nSheet.Select
Cells.Find(What:="total cost", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveSheet.Paste
'Adding Risk provision row above total costs
dSheet.Range("A63:X63").Copy
nSheet.Select
Cells.Find(What:="total cost", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Modifying Simplified RITE
'Adding Start and end of provision, inserting provision matrix, hiding matrix
Set nSheet = wbD.Sheets("Simplified RITE")
Set dSheet = wbS.Sheets("Simplified RITE")
With nSheet
.Select
.Range("E4").EntireColumn.Insert
.Range("C4").ColumnWidth = 34
.Range("E4").ColumnWidth = 14
.Range("F4").ColumnWidth = 14
End With
With dSheet
.Range("E4:F17").Copy Destination:=nSheet.Range("E4")
.Range("D5").Copy Destination:=nSheet.Range("D5")
.Range("A50:N63").Copy Destination:=nSheet.Range("A50")
.Range("P6:P17").Copy Destination:=nSheet.Range("P6")
End With
Rows("50:63").EntireRow.Hidden = True
Columns("P").EntireColumn.Hidden = True
Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
With wbD
.Sheets("REL Scoring").Visible = xlHidden
.Sheets("Summary").Select
.Sheets("PMF").Visible = xlHidden
End With
Application.CutCopyMode = False
wbD.Close savechanges:=True
End If
sFile = Dir 'next file
Loop
UserForm1.Show
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
Bookmarks