Excel 将数据从一个工作簿复制到另一个工作簿
我的要求是将多个工作簿中的前两张工作表复制到一个主工作簿中。我让它大部分时间都在工作。正确复制第一张图纸。在执行第二个命令时,我得到一个错误“应用程序定义的或对象定义的错误”。我无法找出到底是什么地方出了问题。任何帮助都将不胜感激。这是复制的代码。以下代码之前的任何操作都涉及打开源文件夹、目标工作簿和设置Excel 将数据从一个工作簿复制到另一个工作簿,excel,vba,Excel,Vba,我的要求是将多个工作簿中的前两张工作表复制到一个主工作簿中。我让它大部分时间都在工作。正确复制第一张图纸。在执行第二个命令时,我得到一个错误“应用程序定义的或对象定义的错误”。我无法找出到底是什么地方出了问题。任何帮助都将不胜感激。这是复制的代码。以下代码之前的任何操作都涉及打开源文件夹、目标工作簿和设置 Set shtDest = ActiveWorkbook.Sheets(1) Set shtDest2 = ActiveWorkbook.Sheets(2) Filename = Dir(p
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
第一组代码运行良好。我得到的错误在集合CopyRng2上。我做错了什么,还是遗漏了什么
提前感谢原因很简单。
单元格
对象在中未完全限定
Set CopyRng2=Wkb.Sheets(2).范围(单元格(第1行),单元格(ActiveSheet.UsedRange.Rows.Count,ActiveSheet.UsedRange.Columns.Count))
此时您的Sheets(1)
处于活动状态,因此Cells
对象指的是Sheets(1)
,它也是Activesheet
人们应该始终完全限定对象。试试这个代码
用这个替换那条线(注意点?)
其他的也一样
再加一张。避免使用
UsedRange
。尝试查找最后一行和最后一列,然后构建您的范围。您可能想查看您的代码,您需要指出您想要的范围
这是一个简单的示例,可能会让人困惑,因为您在同一行中引用了图纸和活动图纸
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复制时,焦点仍在图纸1上 尝试(换行以使其可读): 我假设在未指定RowofCopySheet的情况下,您不想复制整个工作表 否则,如果您需要整个工作表,则@brettdj中的此语法可能会起作用
问题似乎是您试图使用对另一个工作表的引用在一个工作表中设置范围
Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
在“CopyRng2”的情况下,“Wkb.Sheets(2)”和活动工作表之间存在冲突,在这种情况下,活动工作表似乎是“shtDest”,因为这是发生复制粘贴的地方
在第一份副本中也是如此,因为“Wkb.Sheets(1)”也是当时的活动表,所以在第一份副本中没有错误
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
要消除此类错误,请避免使用activesheet(如果您使用的是多窗口excel 2013,则必须使用activesheet),请始终使用如下代码,明确您使用的对象:
With WbkSrc.Worksheets(b)
Set aRngSrc(b) = Range(.Cells(kRowCopyFrom, 1), .UsedRange.SpecialCells(xlLastCell))
End With
以下是对原始代码的一些调整:
我考虑了以下假设:
在此过程之前定义了以下变量
kPath
WbkTrg(目标工作簿)
kRowCopyFrom(第行共页)
还添加了以下常量,以便灵活地控制要复制的工作表的数量
常量kWshCnt作为字节=2
还提供了两种在目标工作表中“粘贴”值的备选方案(请参见下面的选项1和2)
谢谢@DaveExcel。很好的解决方案。我知道你和悉达思都来自哪里。
Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
With WbkSrc.Worksheets(b)
Set aRngSrc(b) = Range(.Cells(kRowCopyFrom, 1), .UsedRange.SpecialCells(xlLastCell))
End With
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