VB求助

不如不会

Sub 拆分()
Dim w As Workbook, wb As Workbook, st As Worksheet, st1 As Worksheet
Dim d, r
Set d = CreateObject("scripting.dictionary")
Set w = ThisWorkbook
Set st = w.Worksheets("数据库")
r = [ab3] '设定起始数
Do
      r = r + 1 '开始行
      If st.Cells(r, "a") = "" Then Exit Do '如果为空就结束
      If r = [ac3] Then Exit Do '如果达到设定次数就结束
      d(st.Cells(r, "a").Value) = Array(st.Cells(r, "a").Resize(1, 1).Value) '将查询行第1列数值赋予数据库d
Loop
      Set st1 = Sheet6 '模板赋值为st1
For Each r In d
      st1.Copy
      Set wb = ActiveWorkbook '建立工作薄
      Set st = ActiveSheet '建立工作表
      st.Name = r '工作表名称为r值
      st.[t4:t4] = WorksheetFunction.Transpose(d(r)(0)) '将数据库值复制到T4:U4
      ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value '转变无公式
      wb.SaveAs w.Path & "\" & r & ".xlsx"  '希望将文件名称为r值的第2列.xlsx
      wb.Close '关闭工作表
Next

不如不会

请各位大神指点一下

不如不会

问题已解决