运行下面提到的 VBA 代码时出现两个运行时错误答案

【问题标题】：I am getting two run-time errors while running below mentioned VBA code运行下面提到的 VBA 代码时出现两个运行时错误
【发布时间】：2014-01-13 15:51:00
【问题描述】：

我收到以下错误“运行时错误'1004'应用程序定义或对象定义错误并突出显示以下代码行 newb.sheets(shts(s)).Range("a1").Resize(, cols).Value = wb.sheets(shts(s)).Range(heds(s)).Value

当我跳过上面的代码行并移至下一行时，它显示另一个错误“运行时错误'9'脚本超出范围”并突出显示以下代码行 "newb.sheets(shts(s)).Range("a" & rw(s)).Resize(rws, cols).Value = wb.sheets(s).Range(Rng(s) & rws - 1).Value" 请帮我做什么。

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

 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

【问题讨论】：

rng(s) & rws - 1 应该做什么？您会以这种方式创建范围地址，这似乎很奇怪。
你也可以做类似dim rightSide as vaiant, leftSide as vaiant: set rightSide = Wb.Sheets(shts(s)).Range(heds(s)): set leftSide = newb.Sheets(shts(s)).Range("a1").Resize(, cols)的事情。 leftSide 和 rightSide 等于什么？
这些是三个工作表中需要复制的行范围
对象设置成功了吗？
我目前在一个文件夹中有 55 个工作簿（例如“C:\Consolidation”），每个工作簿包含 11 个工作表。我需要从所有 55 个工作簿中合并以下三个工作表 1. Total Consolidation、2. State level Consolidation 和 3. District Level Consolidation，并将其保存在同一文件夹中新工作簿的三个不同工作表中（即 C:\合并）。

标签： vba excel

【解决方案1】：

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

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

您想要的是从数组中获取一个值，例如 Cols(0)，以便它获取 11 或 7 或 13

例如

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

【讨论】：

谢谢。让我检查一下。
当我使用数字 7、11 或 13 时，我收到另一个错误“下标超出范围。此外，如果我放置 Cols(s) 或 Cols(0)，则不会从源工作表复制数据到新工作表
您收到Subscript out of range，因为 Excel 找不到相关对象。例如Sheets(shts(s))。确保工作表名称与实际工作表名称匹配。确保没有不需要的空格等...
我完全迷路了。我已经多次检查了工作表的名称，一切都是文件，但我仍然收到此错误。
在逐步执行过程中，当我将光标放在代码上时，它正确显示了名称，但数据没有被复制到新工作表中。

【解决方案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

【讨论】：