Copying data from one workbook to another

Question

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?

Thanks in advance

Answer 1

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

Set 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

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

Answer 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

Answer 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.

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?

Else this syntax from @brettdj may work if you want the whole sheet 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

Answer 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.

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

    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:

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)

kRowCopyFrom (RowofCopySheet)

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

Const kWshCnt As Byte = 2

Also presenting two alternatives to “paste” the values in the target worksheets (see below options 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