Copy rows of multiple workbooks into one main workbook - excel

Question

I want to open a workbook that contains only one sheet,
copy data up to column AC until last available row in column A,
paste the data into first empty row in column A in workbook "Mergedsheet.xlsx".
I want to loop over all workbooks present in a specific folder, but get lots of errors.
Sub MergeNew()
Dim WorkBk As Workbook
Dim MergedSheet As Worksheet
Dim SourceData As Range
Dim DestinationData As Range
Dim lastRow As Long
Dim NextRow As Range
Dim FolderPath As String
Dim FileNames As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
FolderPath = "E:\Jan to March 2019\Bharuch 31\"
FileNames = Dir(FolderPath & "*.xls*")
Do While FileNames <> ""
Set WorkBk = Workbooks.Open(FolderPath & FileNames)
Range("A1:AC1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Open Filename:="E:\Jan to March 2019\Bharuch 31\MergedSheet.xlsx"
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastRow).Select
ActiveSheet.Paste
'ActiveWindow.Close SaveChanges:=True
'ActiveWindow.Close SaveChanges:=False
Application.CutCopyMode = False
FileNames = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

You are looping through a folder and copy-pasting each workbook's first sheet's data to workbook A. However, workbook A is also in that folder. So you should take care to skip it (when looping).
(Alternatively, you could provide a different argument to the DIR function (e.g. some wildcard criteria that excludes workbook A if possible), so that you don't have to constantly check inside the loop.)
Untested.
Option Explicit
Private Sub MergeNew()
'Application.ScreenUpdating = False 'Uncomment this when you know code is working.
'Application.DisplayAlerts = False 'Uncomment this when you know code is working.
Dim folderPath As String
folderPath = GetFolderPath(titleToShow:="Select the folder containing the files to loop through.")
Dim Filename As String
Filename = Dir$(folderPath & "*.xls*")
If Len(Filename) = 0 Then
MsgBox "Could not find a relevant file in '" & folderPath & "'. Code will stop running now."
Exit Sub ' No point in carrying on in such a case.
End If
Dim destinationFolderPath As String
destinationFolderPath = GetFolderPath(titleToShow:="Select the folder to save the 'MergedSheet.xlsx' file to.")
Dim destinationWorkbook As Workbook
Set destinationWorkbook = Application.Workbooks.Add
' This line may throw an error
destinationWorkbook.SaveAs Filename:=destinationFolderPath & "MergedSheet.xlsx", FileFormat:=xlOpenXMLWorkbook
Dim destinationSheet As Worksheet
Set destinationSheet = destinationWorkbook.Worksheets(1) ' I assume there's only 1 sheet in there, but change as necessary.
Do Until Len(Filename) = 0
Dim fullFilePathToOpen As String
fullFilePathToOpen = folderPath & Filename
If fullFilePathToOpen <> destinationWorkbook.FullName Then ' Probably could have just compared filename since directory is the same, but this is more explicit
Dim sourceWorkbook As Workbook
Set sourceWorkbook = Application.Workbooks.Open(Filename:=fullFilePathToOpen, ReadOnly:=True) ' If you don't make changes to the workbook you open, better to open as read-only
Dim sourceSheet As Worksheet
Set sourceSheet = sourceWorkbook.Worksheets(1) ' You say there's only one worksheet in there, so referring by index should be okay (for now)
Dim lastSourceRow As Long
lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row ' Assume last row can be determined from column A alone
Dim lastDestinationRow As Long
lastDestinationRow = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row + 1
If destinationSheet.Rows.Count < (lastDestinationRow + lastSourceRow) Then
MsgBox "Ran out of rows (in sheet '" & sourceSheet.Name & "' of workbook '" & destinationWorkbook.Name & "')"
Exit Sub
End If
sourceSheet.Range("A1", sourceSheet.Cells(lastSourceRow, "AC")).Copy Destination:=destinationSheet.Cells(lastDestinationRow, "A")
sourceWorkbook.Close False
End If
Filename = Dir$()
Loop
'Application.ScreenUpdating = True 'Uncomment this when you know code is working.
'Application.DisplayAlerts = True 'Uncomment this when you know code is working.
End Sub
Private Function GetFolderPath(Optional ByVal titleToShow As String = vbNullString) As String
With Application.FileDialog(msoFileDialogFolderPicker)
If Len(titleToShow) > 0 Then .Title = titleToShow
.AllowMultiSelect = False ' Only one is allowed.
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Folder selection appears to have cancelled. Code will stop running now"
End
End If
GetFolderPath = .SelectedItems(1) & "\"
End With
End Function