我的要求是将多个工作簿中的前两个工作表复制到一个主工作簿中。我大部分时间都在工作。第一张表格被正确复制。执行第二个时，我收到错误“应用程序定义或对象定义错误”。我无法找出究竟是什么问题。任何帮助将非常感激。这是复制的代码。以下代码之前的任何内容都涉及打开源文件夹，目标工作簿和设置
Set shtDest = ActiveWorkbook.Sheets(1)
Set shtDest2 = ActiveWorkbook.Sheets(2)
Filename = Dir(path & "\*.xlsx", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest2 = shtDest2.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng2.Copy Dest2
Wkb.Close False
End If
Filename = Dir()
Loop
第一组代码工作正常。我得到的错误是在Set CopyRng2上。我做错了什么或者我错过了什么？
提前致谢
答案 0 :(得分：2)
原因很简单。 <{1}}对象未完全限定在
中 Cells
此时您的Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))处于有效状态，因此Sheets(1)对象指的是Cells，也是Sheets(1)
应始终完全限定对象。试试这段代码
用此替换该行（注意点？）
Activesheet同样适用于其他人。
另外一个注意事项。避免使用With Wkb.Sheets(2)
Set CopyRng2 = .Range(.Cells(RowofCopySheet, 1), _
.Cells(.UsedRange.Rows.Count, _
.UsedRange.Columns.Count) _
)
End With
。尝试找到最后一行和列，然后构建您的范围。您可能希望看到This
答案 1 :(得分：1)
您的代码令人困惑，您需要指明您希望范围的工作表。
这是一个简单的例子，它可能令人困惑，因为你在同一行上引用了工作表和活动工作表。
Set wkb = Workbooks.Open(Filename:=Path & "\" & Filename)
With wkb.Sheets(1)
Set CopyRng = .Range(.Cells(RowofCopySheet, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
End With
With wkb.Sheets(2)
Set CopyRng2 = .Range(Cells(RowofCopySheet, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
End With
With shtDest
Set Dest = .Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
With shtDest2
Set Dest2 = .Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
CopyRng.Copy Dest
CopyRng2.Copy Dest2
wkb.Close False
End If
答案 2 :(得分：0)
我认为问题可能是ActiveSheet。其often recommended to avoid this并明确表格。当您尝试从工作表2复制时，焦点仍然在工作表1上。
尝试（换行符使其可读）：
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1),
Cells(Wkb.Sheets(1).UsedRange.Rows.Count,
Wkb.Sheets(1).UsedRange.Columns.Count))
我假设没有指定RowofCopySheet你不想复制整张表吗？
如果你想要整张表，那么@brettdj的这个语法可能会有效 Copy an entire worksheet to a new worksheet in Excel 2010
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets(1)
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub
' in your case
' You need to set your destination workbook.
' You could use your code at start but would be better to explicitly name it
set MasterWkb = ActiveWorkbook
...
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set wsCopy = Wkb.Sheets(1)
wsCopy.Copy MasterWkb.Sheets(Sheets.Count)
' i.e. Copy to end of master workbook
答案 3 :(得分：0)
问题似乎是您尝试使用对另一个工作表的引用在一个工作表中设置范围
Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
在“CopyRng2”的情况下，冲突发生在＆＃34; Wkb.Sheets（2）＆＃34; 和本例中的活动表之间似乎是＆＃34; shtDest＆＃34; ，因为这是发行copypaste的那个。
在第一个副本中也是这种情况，第一个副本没有错误，因为＆＃34; Wkb.Sheets（1）＆＃34;也是当时的活动表
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
要消除此类错误，请避免使用活动表（如果您使用的是多窗口Excel 2013，则必须使用此类错误），始终具体说明您正在使用的对象，使用如下代码：
With WbkSrc.Worksheets(b)
Set aRngSrc(b) = Range(.Cells(kRowCopyFrom, 1), .UsedRange.SpecialCells(xlLastCell))
End With
在下面找到对原始代码的一些调整：
我考虑过以下假设： 在此过程之前定义了以下变量
kPath
WbkTrg（目标工作簿）
kRowCopyFrom（RowofCopySheet）
还添加了以下常量，以便灵活处理要复制的工作表数量
Const kWshCnt As Byte = 2
还提供了两种“粘贴”目标工作表中的值的替代方法（参见下面的选项1＆amp; 2）
Option Explicit
Option Base 1
Rem Previously defined
Const kPath As String = "D:\!EEM Documents\!Desktop\@Trash\TEST"
Const kRowCopyFrom As Byte = 6
Dim WbkTrg As Workbook
Rem New constant
Const kWshCnt As Byte = 2
Sub Solution_CopyWshsFromAllFilesInFolder()
Dim sFileSrc As String
Dim WbkSrc As Workbook
Dim aRngSrc(kWshCnt) As Range
Dim aRowIni(kWshCnt) As Long
Dim RngTrg As Range
Dim b As Byte
sFileSrc = Dir(kPath & "\*.xlsx", vbNormal)
If Len(sFileSrc) = 0 Then Exit Sub
Do Until sFileSrc = vbNullString
If Not sFileSrc = WbkTrg.Name And Not sFileSrc Like "CopyWshsFromAllFilesInFolder_*" Then
Set RngTrg = Nothing
Set WbkSrc = Workbooks.Open(Filename:=kPath & "\" & sFileSrc)
Rem Validates required number of worksheets in source workbook
If WbkSrc.Worksheets.Count >= kWshCnt Then
For b = 1 To kWshCnt
Rem Sets source range
With WbkSrc.Worksheets(b)
Set aRngSrc(b) = Range(.Cells(kRowCopyFrom, 1), .UsedRange.SpecialCells(xlLastCell))
End With
With WbkTrg.Worksheets(b)
Rem Resets the Starting row to set the values from source ranges
Rem Leaves one row between ranges to ensure no overlapping
If aRowIni(b) = 0 Then aRowIni(b) = kRowCopyFrom Else aRowIni(b) = 2 + .UsedRange.SpecialCells(xlLastCell).Row
Rem Option 1 - Brings only the values from the source ranges
Set RngTrg = Range(.Cells(aRowIni(b), 1), .Cells(-1 + aRowIni(b) + aRngSrc(b).Rows.Count, aRngSrc(b).Columns.Count))
RngTrg.Value = aRngSrc(b).Value2
Rem Option 2 - Paste the values and number formats from the source ranges
Rem This option only uses the starting cell to paste the source ranges
Set RngTrg = .Cells(aRowIni(b), 1)
aRngSrc(b).Copy
RngTrg.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End With: Next: End If
WbkSrc.Close False
End If
sFileSrc = Dir()
Loop
End Sub