Code to Copy Row to Table in Closed Workbook

[BuXFaN5]

Hello,

I am trying to write code to copy a row from one workbook into another closed workbook by hitting a submit button. I have a form on worksheet "TallyForm" and then a sheet "Transfer" that transposes the data from the form into one row. The data is populating an accumulating table. The code I have currently is for transferring within one workbook to sheet "QualityData" but I would like to build the table in a separate workbook as it will become quite large over time. Ideally the person filling out the form would not have to open a closed workbook where the table will be contained. The code I have is rough as I am new to writing macros but hopefully it can communicate what I am trying to do.

Sub Submit()
'
' Submit Macro
'
    ThisWorkbook.Unprotect Password:="ABC"
    Sheets("QualityData").Select
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Sheets("Transfer").Select
    Rows("4:4").Select
    Selection.Copy
    Sheets("QualityData").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("TallyForm").Select
   
    Dim Name As String
   
    Name = ThisWorkbook.Path & "\" & ActiveSheet.Name & " " & _
        Format(Now(), "mm.dd.yy hh.mm") & ".pdf"
   
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
 
    Range("$H$1:$N$1").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("$S$1:$T$1").Select
    Selection.ClearContents
    Range("$Z$1:$AI$1").Select
    Selection.ClearContents
    Range("$AM$1:$AO$1").Select
    Selection.ClearContents
    Range("$AW$1:$BA$1").Select
    Selection.ClearContents
    Range("$BK$1:$BO$1").Select
    Selection.ClearContents
    Range("$BY$1:$CC$1").Select
    Selection.ClearContents
    Range("$H$5:$AM$11").Select
    Selection.ClearContents
    Range("$AX$5:$CC$12").Select
    Selection.ClearContents
    Range("$I$16:$Q$23").Select
    Selection.ClearContents
    Range("$I$26:$Q$35").Select
    Selection.ClearContents
    Range("$Z$16:$AH$26").Select
    Selection.ClearContents
    Range("$Z$29:$AH$31").Select
    Selection.ClearContents
    Range("$AQ$16:$AY$31").Select
    Selection.ClearContents
    Range("$BH$16:$BP$32").Select
    Selection.ClearContents
    Range("$BY$16:$CG$24").Select
    Selection.ClearContents
    Range("$Z$35:$AH$35").Select
    Selection.ClearContents
    Range("$AQ$35:$AY35").Select
    Selection.ClearContents
    Range("$BH$35:$BP$35").Select
    Selection.ClearContents
    Range("A1").Select
    ThisWorkbook.Protect Password:="ABC"
End Sub

I came across the code below but am struggling to incorporate for what I want to do.

Sub Copy()
Sheets("Sheet1").Range("A2:D26").Copy
Workbooks.Open("C:\Users\j\Trial.xltx").Activate
Sheets("Sheet1").Range("A6").PasteSpecial xlPasteValues
Application.CutCopyMode = False
rngDest.Insert xlShiftDown
  Err_Execute:
If Err.Number = 0 Then MsgBox "Copying Successful :)" Else _
MsgBox Err.Description
End Sub

Thanks in advance for the help!

 

[BuXFaN5]

There was also the code below which might have been closer but again I am struggling to incorporate.

Option Explicit
 
Sub copytoarchive()
    Dim destSht As Worksheet
 
    Workbooks.Open ("C:\...\FileToCopyTo.xlsx") 
    Set destSht = ActiveWorkbook.Worksheets("Archive") 
 
    With ThisWorkbook.Worksheets("DIC") 
        With .Range(.Range("A4:Q4"), .Range("A4:Q4").End(xlDown)) 
            destSht.Cells(destSht.Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value 
        End With
    End With
 
    destSht.Parent.Close True 
End Sub