Thanks for looking at my Post. I recently added the code below to a workbook so It would Archive my data and provide me with a Hyperlink back to the orginal sheet.
The have recently added the code to a very similar workbook and it debugs at this line:
Then Sheets("Sheet1").Range("H" & NR + I).Formula = HypoForm & ws1.Range("A" & I + 4).Address
Im not sure why. the only thing that changed to my knowledge is that it had a few more columns.
The code below is the entire module. If you see anything I need to change to make this work please let me know.
Also on the workbook this is working on it puts all the information in Cloumn I it just does seem to hyperlink to the location when I click on it
Thanks again

Sub FINALIZED_BY_QC_job()

Dim newFileName As String
Dim appendtext As String
Dim rngfil As Range, cell As Range
Dim NR As Long, I As Long
Set ws1 = ActiveWorkbook.Sheets("JOB CUTTING FORM")

SourcePath = ActiveWorkbook.Path
SourceFile = ActiveWorkbook.name

If UCase(InputBox("Enter Password")) <> "1288" Then Exit Sub

With ActiveSheet
.Unprotect Password:="1288"
With .Range("J24").Interior
.Pattern = xlSolid
.PatternColorIndex = 1
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
appendtext = "-FINAL"
.Range("J24").FormulaR1C1 = appendtext
 
    ActiveSheet.Shapes.Range(Array("Button 206")).Select
    Selection.OnAction = "PURCH_COMMENTS_JOB"

Range("$g$1:$j$1").Locked = True
    
    Cells.Select
    Selection.Locked = True
    Range("v4:v22").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveSheet.EnableSelection = xlUnlockedCells
    Range("v4").Select
Set rngfil = Range("A4,B4,C4,G4,I4,S4,T4") 'first row of data to be processed
For r = 0 To 16  'row offset variable
EmptyRowCheck = ""
For Each cell In rngfil.Offset(r, 0)        'Concat values of cells in rngfil offset
EmptyRowCheck = EmptyRowCheck & cell
Next cell
If EmptyRowCheck = "" Then GoTo FoundEmptyRow  ' if "" empty row of rngfil cells found so stop putting -
For Each cell In rngfil.Offset(r, 0)  'otherwise put - in any empty cell
If cell.Value = vbNullString Then
 cell.Value = "-"
 End If
Next cell
Next r
FoundEmptyRow:  'stop putting -
' Archive values to ....
Filename = "C:\Users\JEpperson\Documents\Burney Table-1\CUTTING FORMS (Protected by QC)\PC Archive\PC Excel Archive.xls"
Workbooks.Open (Filename)

HypoForm = "=HYPERLINK('" & SourcePath & "\[" & SourceFile & "]" & ws1.name & "'"

NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
For I = 0 To 19
    Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("A" & I + 4).Value
    Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I + 4).Value
    Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I + 4).Value
    Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("G" & I + 4).Value
    Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("I" & I + 4).Value
    Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("S" & I + 4).Value
    Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("T" & I + 4).Value
    'Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I + 4).Value
          If Not ws1.Range("A" & I + 4).Value = "" Then Sheets("Sheet1").Range("H" & NR + I).Formula = HypoForm & ws1.Range("A" & I + 4).Address
Next I
    'ActiveWorkbook.Save
    'ActiveWorkbook.Close
.Protect Password:="1288", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With

With ActiveWorkbook
    oldFileName = .FullName
    newFileName = Left(.FullName, InStrRev(.FullName, ".xls") - 1) _
        & appendtext
    .SaveAs Filename:=newFileName
End With
Kill oldFileName
'Application.Quit
End Sub