代码已使用多年,最近停止工作。
我已经升级到Office 365了。
代码应该复制工作表“响应”,粘贴一个单元格的副本从“数据库”,并命名新的工作表适当。它将继续在工作簿中创建新工作表,直到“数据库”列表结束。
我得到:
运行时错误“1004”:Microsoft Excel无法粘贴数据。
代码运行并创建一个工作表“Response4”。(我只给了数据库4行来复制。Debug突出显示ActiveSheet.Paste link:=True
行。
代码在我公司的系统之外工作。(我把它和虚拟数据一起发给了一个朋友,它起作用了。)
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
1条答案
按热度按时间9njqaruj1#
由于“粘贴链接”需要在粘贴之前选择范围,我会跳过这一点,并创建一个方法来执行该功能。
另外,使用工作表变量可以减少代码中的重复,并使维护更容易。