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
Bookmarks