将数据从一个工作簿复制到另一个工作簿

My requirement is to copy the first 2 sheets from multiple workbooks into one single master workbook. I had it working for most part. The first sheet gets copied correctly. While executing the second, I get an error "Application defined or Object Defined error". I am unable to find out what exactly is wrong. Any help would be much appreciated. Here is the code for copying. Anything before the code below involves opening up the source folder, destination workbook and set

我的要求是将多个工作簿中的前两页复制到一个主工作簿中。我大部分时间都在工作。第一张表格被正确复制。执行第二个时,我收到错误“应用程序定义或对象定义错误”。我无法找出究竟是什么问题。任何帮助将非常感激。这是复制的代码。以下代码之前的任何内容都涉及打开源文件夹,目标工作簿和设置

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

The first set of code works fine. The error that I get is on the Set CopyRng2. What am I doing wrong or am I missing anything?

第一组代码工作正常。我得到的错误是在Set CopyRng2上。我做错了什么或者我错过了什么?

Thanks in advance

提前致谢

4 个解决方案

#1

The reason is very simple. The Cells Object is not fully qualified in

原因很简单。 Cells对象未完全限定

Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))

设置CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet,1),Cells(ActiveSheet.UsedRange.Rows.Count,ActiveSheet.UsedRange.Columns.Count))

Your Sheets(1) is active at this moment and hence the Cells Object is referring to Sheets(1) which is also the Activesheet

您的表格(1)此时处于活动状态,因此单元格对象指的是表格(1),也是活动表格

One should always fully qualify the object. Try this code

应始终完全限定对象。试试这个代码

Replace that line with this (Notice the dots?)

用此替换该行(注意点?)

With Wkb.Sheets(2)
    Set CopyRng2 = .Range(.Cells(RowofCopySheet, 1), _
                          .Cells(.UsedRange.Rows.Count, _
                                 .UsedRange.Columns.Count) _
                          )
End With

Similarly do for other.

同样为其他人做。

One extra note. Avoid using UsedRange. Try and find the last row and column and then construct your range. You may want to see This

一个额外的说明。避免使用UsedRange。尝试找到最后一行和列,然后构建您的范围。你可能想看到这个

#2

Your confusing the code, you need to indicate what sheet you want the ranges.

如果您对代码感到困惑,则需要指明您希望范围的工作表。

Here is a simple example, it may be confusing, because you were referencing sheets and active sheets on the same line.

这是一个简单的例子,它可能令人困惑,因为你在同一行上引用了工作表和活动工作表。

     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

#3

I think the problem may be ActiveSheet. Its often recommended to avoid this and be explicit about the sheet. The focus is still on Sheet 1 when you try copy from Sheet 2.

我认为问题可能是ActiveSheet。通常建议避免这种情况并明确表格。当您尝试从工作表2复制时,焦点仍然在工作表1上。

Try (line breaks to make it readable):

尝试(换行符使其可读):

Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1),
   Cells(Wkb.Sheets(1).UsedRange.Rows.Count,
   Wkb.Sheets(1).UsedRange.Columns.Count))

I assume with RowofCopySheet not specified you dont want to copy whole sheet?

我假设没有指定RowofCopySheet你不想复制整张表?

Else this syntax from @brettdj may work if you want the whole sheet Copy an entire worksheet to a new worksheet in Excel 2010

如果您希望整张工作表将整个工作表复制到Excel 2010中的新工作表,则@brettdj中的此语法可能会起作用

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

#4

The problem seems to be that you are trying to set a range in one worksheet using a reference to another worksheet

问题似乎是您尝试使用对另一个工作表的引用在一个工作表中设置范围

    Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))

In the case of the “CopyRng2” the conflict is between "Wkb.Sheets(2)" and the activesheet which in this case seems to be "shtDest" as this the one where the copypaste took place.

在“CopyRng2”的情况下,冲突在“Wkb.Sheets(2)”和活动表之间,在这种情况下似乎是“shtDest”,因为这是发生copypaste的那个。

This is the case also in the first copy, there was not error at the first copy as the "Wkb.Sheets(1)" was also the activesheet at that time

在第一个副本中也是这种情况,第一个副本没有错误,因为“Wkb.Sheets(1)”也是当时的活动表

    Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))

To eliminate this kind of errors avoid the use of the activesheet (kind of mandatory if you are working with the multi-windows excel 2013), always be specific as to what object you are working with, using code like the following:

要消除这种错误,请避免使用活动表(如果使用多窗口Excel 2013,则必须使用此类错误),始终具体说明您正在使用的对象,使用如下代码:

With WbkSrc.Worksheets(b)
    Set aRngSrc(b) = Range(.Cells(kRowCopyFrom, 1), .UsedRange.SpecialCells(xlLastCell))
End With

Find below some adjustments to you original code:

在下面找到对原始代码的一些调整:

I have consider the following assumptions: The following variables are defined before this procedure

我考虑了以下假设:在此过程之前定义了以下变量

kPath

WbkTrg (target workbook)

WbkTrg(目标工作簿)

kRowCopyFrom (RowofCopySheet)

Have also added the following constant to make it flexible the number of worksheets to be copied

还添加了以下常量,以使其灵活处理要复制的工作表数量

Const kWshCnt As Byte = 2

Const kWshCnt As Byte = 2

Also presenting two alternatives to “paste” the values in the target worksheets (see below options 1 & 2)

还提供了两种“粘贴”目标工作表中的值的替代方法(参见下面的选项1和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