Question

我收到以下错误“运行时错误'1004'应用程序定义或对象定义错误并突出显示以下代码行 newb.sheets（shts（s））。范围（“a1”）。调整大小（，cols）.Value = wb.sheets（shts（s））。范围（heds（s））。值

当我跳过上面的代码行并转到下一行时，它显示另一个错误“运行时错误'9'脚本超出范围”并突出显示以下代码行 “newb.sheets（shts（s））。Range（”a“＆amp; rw（s））。Resize（rws，cols）.Value = wb.sheets（s）.Range（Rng（s）＆amp; ; rws - 1）。价值“请帮助我做什么。

有人可以帮我解决上述错误吗？

 Sub Consolidation()

 Dim newb as workbook
 Dim wb as workbook
 Dim Shts
 Dim rws as long
 Dim rw(2) As Long
 mypath = "C:\Consolidation\"
 shts = Array("Total Consolidation", "State level Consolidation", "District Level Consolidation")

 Set newb = Workbooks.Add
 newb.Sheets(1).Name = shts(0)
 newb.Sheets(2).Name = shts(1)
 newb.Sheets(3).Name = shts(2)

 rw(0) = 1
 rw(1) = 1
 rw(2) = 1

 rng = Array("a6:k", "a2:g", "o2:aa")
 cols = Array("11", "7", "13")
 heds = Array("a1:k1", "a1:g1", "o1:aa1")
 fname = Dir(mypath & "*.xls")

 Do While Len(fname) > 0
     Set Wb = Workbooks.Open(mypath & fname)
 For s = 0 To 2
     rws = Wb.Sheets(shts(s)).UsedRange.Rows.Count - 1

If s = 0 Then rws = rws - 6

If Not headsdone Then
    newb.Sheets(shts(s)).Range("a1").Resize(, cols(s)).value = Wb.Sheets(shts(s)).Range(heds(s)).value
    headsdone = True
End If

newb.Sheets(shts(s)).Range("a" & rw(s)).Resize(rws, cols(s)).value = Wb.Sheets(shts(s)).Range(rng(s) & rws).value

rw(s) = rw(s) + rws - 1

Next

fname = Dir

Loop

newb.SaveAs mypath & "COUNTRY LEVEL CONSOLIDATION.xls"

newb.Close

End Sub

Answer 1

由于Cols中的Resize(, cols)，您收到该错误。 Cols是一个数组，而不是Integer/Long值。

cols = Array("11", "7", "13")

你想要的是从Cols(0)这样的数组中选取一个值，以便它选择11或7或13

例如

newb.Sheets(shts(s)).Range("a1").Resize(, cols(0)).value

Answer 2

我能够修复所有错误。请在下面找到最终代码。

 Sub consolidation()

 Dim newb As Workbook
 Dim wb As Workbook
 Dim rws As Long
 Dim shts
 Dim rw(2) As Long
 Dim s As Integer

 mypath = "C:\Consolidation\"
 shts = Array("Total Consolidation", "State level Consolidation", "District Level Consolidation")
 Set newb = Workbooks.Add

 newb.sheets(1).Name = shts(0)
 newb.sheets(2).Name = shts(1)
 newb.sheets(3).Name = shts(2)

 rw(0) = 1
 rw(1) = 1
 rw(2) = 1

 Rng = Array("a7:k", "a2:g", "o2:aa")
 cols = Array("11", "7", "13")
 heds = Array("a6:k6", "a1:g1", "o1:aa1")
 fname = Dir(mypath & "*.xls")

 Do While Len(fname) > 0
 Set wb = Workbooks.Open(mypath & fname)
 For s = 0 To 2
 rws = wb.sheets(shts(s)).UsedRange.Rows.Count

 Headsdone = True

 If Headsdone Then
    newb.sheets(shts(s)).Range("a1").Resize(, cols(s)).Value = wb.sheets(shts(s)).Range(heds(s)).Value
 End If

 If s = 0 Then
 newb.sheets(shts(s)).Range("a" & rw(s) + 1).Resize(-6 + rws, cols(s)).Value = wb.sheets(shts(s)).Range(Rng(s) & rws).Value
 rw(s) = rw(s) + rws - 6
 End If

 If s = 1 Then
 newb.sheets(shts(s)).Range("a" & rw(s) + 1).Resize(-1 + rws, cols(s)).Value = wb.sheets(shts(s)).Range(Rng(s) & rws).Value
 rw(s) = rw(s) + rws - 1
 End If

 If s = 2 Then
 newb.sheets(shts(s)).Range("a" & rw(s) + 1).Resize(-1 + rws, cols(s)).Value = wb.sheets(shts(s)).Range(Rng(s) & rws).Value
 rw(s) = rw(s) + rws - 1
 End If

 Next

 wb.Close False
 fname = Dir

 Loop
 newb.SaveAs mypath & "COUNTRY LEVEL CONSOLIDATION.xlsx"

 newb.Close

 End Sub

运行下面提到的VBA代码时，我遇到两个运行时错误

2 个答案: