代码有时候会出错，求大神帮忙修改一下

烟火孤星泪

代码有时候会出错，求大神帮忙修改一下，当复制粘贴内容到表格的时候，有时候下标越界,无法运行，麻烦帮忙看看，谢谢

1. Sub 证书导语()
   
2. Dim Arr, Brr(), crr, rc, cc
   
3. Dim d As Object
   
4. 
   
5. Arr = Sheet5.[A3].CurrentRegion
   
6. rc = Sheet1.Cells(Cells.Rows.Count, 1).End(xlUp).Row
   
7. cc = Sheet1.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
   
8. crr = Sheet1.Range(Sheet1.Cells(2, 1), Sheet1.Cells(rc, cc))
   
9. Range("a2:M5000").ClearContents
   
10. r = UBound(Arr)
    
11. Set d = CreateObject("scripting.dictionary")
    
12.     For i = 1 To UBound(crr)
    
13.     d(crr(i, 1)) = i
    
14.     Next
    
15. ReDim Brr(1 To r - 2, 1 To 2 + cc)
    
16. For i = 3 To r
    
17.    
    
18.     Brr(i - 2, 1) = Arr(i, 1)
    
19.     Brr(i - 2, 2) = Arr(i, 4)
    
20.     Brr(i - 2, 3) = Arr(i, 6)
    
21.     For j = 3 To 2 + cc
    
22.     Brr(i - 2, j) = crr(d(Arr(i, 6)), j - 2)
    
23.     Next j
    
24. Next i
    
25. Range("a2").Resize(UBound(Brr), 2 + cc) = Brr
    
26. '插入时间
    
27. 'ActiveSheet.Range("j2").Value = Date + Time
    
28. 'ActiveSheet.Range("j2").NumberFormatLocal = "yyyy-mm-dd h:mm:ss"
    
29. Sheets("证书导语").Range("j2").Value = Date + Time
    
30. Sheets("证书导语").Range("j2").NumberFormatLocal = "yyyy-mm-dd h:mm:ss" & " " & "更新"
    
31. Sheets("打印名单").Range("j2").Value = Date + Time
    
32. Sheets("打印名单").Range("j2").NumberFormatLocal = "yyyy-mm-dd h:mm:ss" & " " & "更新"
    
33. End Sub
    
34. 
    

复制代码

sdytsxd991122

那就加个错误处理试一试，On Error Resume Next。没有附件不好判断