请大神们帮忙修改一下代码

假绅士

附件中有一串代码，是用来将以日期命名的工作表中的数据导入到“流动资产”和“流动负债”两张表中的，但是现在出现一个问题，每当代码Do While arr(n, 1) <> ""运行到表格最后一行，就出现下标越界的提示的，想让大神们帮忙看看怎么解决。以下是代码原文，由于我们附表发生了变动，所以这个代码运行出状况了。想麻烦大神们帮忙改改。
整张表格的设计思路如下：
1、点击“提取文件”按钮，代码自动将文件所在文件夹内的指定文件导入到工作簿内，工作表按照日期顺序自动排列
2、点击“提出数据”按钮，代码自动将导入工作表的指定数据导入到“流动资产方”和“流动负责方”带有编码且对应日期的单元格内
3、点击“数据计算”按钮，代码自动按照指定公式将带有编码单元格内的数据计算并填充到对应单元格内
请大神们改完下面这段代码后可以帮我看看其他的代码有没有什么需要改的，本人小白，懂的不多，感谢指点！！！

1. Sub 提出数据()
   
2.     Dim d, k, sht, n$, br, arr
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Sheets("流动资产方").Activate
   
5.     For Each k In Range(Range("a3"), Range("a33")).Cells
   
6.         Set d(k.Text) = CreateObject("scripting.dictionary")
   
7.            With Sheets(k.Text)
   
8.             arr = .Range(.Range("a1"), .Range("a6").End(xlDown).Offset(, 9))
   
9.            End With
   
10.         n = 10
    
11.         Do While arr(n, 1) <> ""
    
12.             d(k.Text)(arr(n, 1)) = arr(n, 7) & arr(n, 8)
    
13.             n = n + 1
    
14.         Loop
    
15.     Next
    
16.     For Each sht In Array(Sheets("流动资产方"), Sheets("流动负债方"))
    
17.         If sht.Name = "流动资产方" Then br = Array(2, 4, 7, 8, 9, 14) _
    
18.         Else br = Array(2, 4, 5, 6)
    
19.         Set Rng = sht.Range(sht.Range("a1"), sht.Range("a3:a33").Offset(, 16))
    
20.         For I = 3 To Rng.Rows.Count
    
21.             For j = 0 To UBound(br)
    
22.                 With Rng
    
23.                 dt = Format(Rng(I, 1))
    
24.                 .Cells(I, br(j)) = d(dt)(.Cells(2, br(j)).Text)
    
25.                 End With
    
26.             Next
    
27.         Next
    
28.     Next
    
29. End Sub
    
30. 复制代码

复制代码

假绅士

朱荣兴 发表于 2018-1-3 11:48
修改代码还得理原代码的思路，

那如果可以的话，可以麻烦您帮忙写一个么？