VBA cant copy and paste cell with single value

Question

I have a code that loop through excel files in a folder and copy the value and paste them to a new workbook.

The problem occur when I have files that only have a single value in the cell. It return an error stating

copy area and paste area aren't the same size

Below is my code:

Sub MergeDataFromWorkbooks()
    'DECLARE AND SET VARIABLES
    Dim wbk As Workbook
    Dim wbk1 As Workbook
    Set wbk1 = ThisWorkbook

    Dim Filename As String
    Dim Path As String
    Path = "C:\Users\Desktop\merge all to one\" 'CHANGE PATH ACCORDING TO FOLDER DIRECTORY LEAVING \ AT THE END
    Filename = Dir(Path & "*.xlsx")

    '--------------------------------------------
    'OPEN EXCEL FILES
    Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
        Set wbk = Workbooks.Open(Path & Filename)
        wbk.Activate
        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("Book1.xlsm").Activate
        Application.DisplayAlerts = False

        Dim lr As Double
        lr = wbk1.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

        Sheets(1).Select
        Cells(lr + 1, 1).Select
        ActiveSheet.Paste
        wbk.Close True
        Filename = Dir
    Loop

    MsgBox "All the files are copied and pasted in Book1."
End Sub

Answer 1

First of all some thoughts to improve your coding style

1. You should avoid using Selection, Select and Activate because this is a bad practice and slows down your code a lot. You can do all actions without using them. In most cases you should never use them (there are a very little number of special cases).

2. Don't use eg. Range or Cells without specifying a worksheet. Otherwise Excel tries to guess which worksheet you mean and it will probably fail doing this. Guessing is not knowing, therefore always tell Excel which worksheet you mean like Worksheets(1).Range or Worksheets("SheetName").Range.

3. Use descriptive variable names. Names like wbk and wbk1 are not very descriptive and later you don't know what wbk1 was and mess things up. Instead use something like wbDestination and wbSource everybody knows what that means now.
   Also it might be a good practice to declare the variables close to their first use, especially when code gets a bit longer.

4. Always use Worksheets instead of Sheets if possible. Sheets also contains charts not only workbooks but in most cases you just want the Worksheets. You say it doesn't matter? Well it does. Sheets(1).Range will throw an error if the first sheet is a chart. We can avoid that.

Now lets start tidy up …

Instead of activate, select 3 times and copy

wbk.Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

We can just copy without any ativate or select which is a lot faster and has the same effect:

With wbSource.Worksheets(1).Range("A2")
    'copy without select
    .Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Copy
End With

---

When we close the source workbook

wbSource.Close SaveChanges:=False

we don't need to save the changes because we didn't change anything. This is more secure and a lot faster.

So we end up with

Option Explicit

Sub MergeDataFromWorkbooks()
    Dim wbDestination As Workbook
    Set wbDestination = ThisWorkbook

    Dim Path As String
    Path = "C:\Temp\" 'make sure it ends with \

    Dim Filename As String
    Filename = Dir(Path & "*.xlsx")

    Do While Len(Filename) > 0 'while file exists
        Dim wbSource As Workbook
        Set wbSource = Workbooks.Open(Path & Filename)    

        With wbSource.Worksheets(1).Range("A2")
            'copy without select
            .Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Copy
        End With

        Dim lRow As Double
        lRow = wbDestination.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'find next empty row

        wbDestination.Worksheets(1).Cells(lRow + 1, 1).PasteSpecial Paste:=xlPasteAll 'paste all

        wbSource.Close SaveChanges:=False 'we don't need to save changes we didn't change anything just copied
        Filename = Dir 'next file
    Loop

    MsgBox "All the files are copied and pasted in Book1."
End Sub

Alternative way to determine the last used cell (column and row) in the source file

This avoids errors when row 2 is the last used row.

With wbSource.Worksheets(1).Range("A2")
    .Resize(.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row - .Row + 1, .Parent.Cells(.Row, .Parent.Columns.Count).End(xlToLeft).Column - .Column + 1).Copy
End With

Explanation:

.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row

finds the last used row in column A by starting from the very last cell in Excel and going up (like pressing ctrl + up).

Answer 2

I don't see why your code is thrown a Copy Area and Paste area aren't the same size error. Unless there are merged cells.

Select and Active are generally used to show the user something. You can and should not use them unless absolutely necessary. I recommend watching: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)

Dim Source As Range
Application.DisplayAlerts = False
Do While Len(Filename) > 0                        'IF NEXT FILE EXISTS THEN

    With Workbooks.Open(Path & Filename)
        Set Source = .Range(.Range("A" & .Rows.Count).End(xlUp), .Cells(1, 
        .Columns.Count).End(xlToLeft))
    End With

    Source.Copy Workbooks("Book1.xlsm").Range("A" & .Rows.Count).End(xlUp)
    .Close False
    Filename = Dir
Loop