Create new sheet and copy text into cell

Question

Code have been using for years recently stopped working.

I've since upgraded to Office 365.

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.

I get:

Run-time error '1004': Microsoft Excel cannot paste the data.

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.

The code works outside of my company's system. (I sent it to a friend with dummy data and it worked.)

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