Excel VBA create new sheet and copy text into cell - excel

Question

I have been using the below code successfully for years but recently it has stopped working. I've since upgraded to Office 365 and still no joy. Essentially the code should copy the Sheet "Response", paste a copy of a cell from "Database" and name the new sheet appropriately. It continues creating new sheets in the workbook until the end of the Database list.
If I run the code as is I get the following: "Run-time error '1004': Microsoft Excel cannot paste the data." When I look at the worksheets, evidentally the code runs and creates a sheet "Response4" (I've only given the database 4 lines to copy). Debug highlights the line ActiveSheet.Paste link:=True. I tested
Frustratingly the code works outside of my company's system (i.e., I sent it to a friend with dummy data and it worked perfectly fine).
Any suggestions very welcome!
Sub CopyCatView()
'NumResp = last row with a responses to the question held within the question 'Themes' database sheet
Dim NumResp As Integer
'x for looping variable
Dim x As Integer
'y for response number variable
Dim y As Integer
Dim ws As Worksheet
Sheets("Database").Activate
NumResp = Range("NumRowsD1").Value + 2
'NumRowsD1 is a named range comprising cell A1 on the Database sheet, which calculates by formula the number of comments in the database
For x = 3 To NumResp
Sheets("Response").Copy before:=Sheets("Response")
y = NumResp - x + 1
ActiveSheet.Name = "Response" & y
ActiveSheet.Range("C2").Value = Sheets("Database").Range("B" & x).Value
ActiveSheet.Range("AA5:CR5").Select
Selection.Copy
Sheets("Database").Select
Cells(x, 3).Select
ActiveSheet.Paste link:=True
Sheets("Response" & y).Activate
ActiveSheet.Range("F4").Select
Selection.Copy
Sheets("database").Select
Cells(x, 70).Select
ActiveSheet.Paste link:=True
'duplicates the Response sheet as many times as there are comments (=X), numbers them Response1 to ResponseX, copies each comment into the white box on a different response sheet from Response1 to ResponseX
'Also links through the check box reporting to the relevant row in the Database sheet
Next x
'at the end hide Sheet "Response"(deleting brings up prompts for every sheet deleted!)
Sheets("Response").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Database").Activate
Range("A1").Select
End Sub

Answer 1

Since the "paste with link" requires ranges to be selected before pasting, I'd skip that and create a method to perform that function.
Also - use worksheet variables to reduce the repetition in your code and make for easier maintenance.
Sub CopyCatView()
Dim NumResp As Long, x As Long, y As Long 'prefer Long over Integer
Dim wsDB As Worksheet, wsResp As Worksheet, ws As Worksheet
Set wsDB = ThisWorkbook.Worksheets("Database")
Set wsResp = ThisWorkbook.Worksheets("Response")
NumResp = wsDB.Range("NumRowsD1").Value + 2
For x = 3 To NumResp
wsResp.Copy before:=wsResp
Set ws = ThisWorkbook.Sheets(wsResp.Index - 1) 'get a reference to the copy
y = NumResp - x + 1
ws.Name = "Response" & y
ws.Range("C2").Value = wsDB.Range("B" & x).Value
LinkRanges ws.Range("AA5:CR5"), wsDB.Cells(x, 3)
LinkRanges ws.Range("F4"), wsDB.Cells(x, 70)
Next x
wsResp.Visible = False
wsDB.Activate
wsDB.Range("A1").Select
End Sub
'Link two ranges in the same workbook
' rngFrom = contiguous (single-area) source range
' rngTo = top-left cell of the destination range
Sub LinkRanges(rngFrom As Range, rngTo As Range)
Dim r As Long, c As Long, nm As String
If Not rngFrom.Parent Is rngTo.Parent Then
nm = "'" & rngFrom.Parent.Name & "'!"
End If
For r = 1 To rngFrom.Rows.Count
For c = 1 To rngFrom.Columns.Count
rngTo.Cells(r, c).Formula = "=" & nm & _
rngFrom.Cells(r, c).Address(False, False)
Next c
Next r
End Sub