VBA cannot copy and paste a cell with a single value

Question

I have code that iterates over excel files in a folder and copies the value and pastes them into a new workbook.

The problem occurs when I have files that have only one value in a cell. It returns an error message

copy area and paste area not 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 on improving the coding style.

• You should avoid using Selection , Select and Activate because it is bad practice and slows down your code significantly. You can do all the actions without using them. In most cases, you should never use them (there are very few special cases).

• Do not use, for example. Range or Cells without specifying a worksheet. Otherwise, Excel is trying to guess which worksheet you have in mind, and it probably won't work. Guessing does not know, therefore it always tells Excel which worksheet you mean as Worksheets(1).Range or Worksheets("SheetName").Range .

• Use descriptive variable names. Names like wbk and wbk1 are not very descriptive, and later you don't know what wbk1 , and you messed it up. Instead, use something like wbDestination and wbSource , everyone knows what that means now. It may also be good practice to declare variables close to their first use, especially when the code gets a little longer.

• Always use Worksheets instead of Sheets , if possible. Sheets also contains diagrams not only of books, but in most cases you just need Worksheets . You say it doesn't matter? Good. Sheets(1).Range will Sheets(1).Range error if the first sheet is a chart. We can avoid this.

Now let's start cleaning ...

Instead of activating, 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 simply copy without any attack or choice, which is much 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 book

 wbSource.Close SaveChanges:=False 

we do not need to save changes because we have not changed anything. It is safer and much faster.

So we are done 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 

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

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

 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 row used in column A, starting from the very last cell in Excel and rising (for example, by pressing ctrl + up ).

Answer 2

I don’t understand why your code generates Copy Area and Paste area aren't the same size error Copy Area and Paste area aren't the same size error. If cells are not merged.

Select and Active are commonly used to show the user something. You can and should not use them if 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