Merge Workbooks based on Number of Row of Data

[akin]

​Hello house. I need urgent help on how to group some workbooks containing one worksheet each with similar data in them but varied rows of data.

The groupping becomes necessary because I want to run a macro script on them which is row sensitivity and has been giving conflicting results.

Please, I need the assistance of experts in the house on groupping the workbooks in the folder. The script will run through or loop through the folder by counting the rows and merge similar workbooks based on number of rows in one sheet. I will not mind if the sheets I will be getting at the end will be in separate worksheets in a workbook.

I already have this VBA script that merge workbooks perfectly:


Sub CopyRange()

Application.ScreenUpdating = False

Dim wkbDest As Workbook, wsDest As Worksheet, wkbSource As Workbook, FolderName As String, lRow As Long

Set wkbDest = ThisWorkbook
Set wsDest = ThisWorkbook.Sheets(1)

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
FolderName = .SelectedItems(1) & ""
End With

ChDir FolderName
strextension = Dir("*.xls*")
Do While strextension <> ""
If wkbDest.Name <> strextension Then
Set wkbSource = Workbooks.Open(FolderName & strextension)
With wkbSource
lRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Sheets(1).UsedRange.Offset(1).Copy wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1)
wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Resize(lRow - 1) = wkbSource.Name
.Close False
End With
End If
strextension = Dir
Loop

Application.ScreenUpdating = True
End Sub

Thanks for your usual assistance.

[akin]

Please, I need urgent assistance of experts in the house for quick resolve of this problem so I will able to move on in my analysis of the data. I am counting on you, please and please. Thanks

[Bob Phillips]

I can't see what you want beyond that code, it seems to do what you ask for, so what is missing?

[akin]

Yes; it merge workbooks perfectly. I just need little modification; I want it to merge the different workbooks in the source folder in separate worksheets in final workbook. For example, all the workbooks that 5 rows of data will be Merged in a worksheet, so also 8 rows and so on and so on.
I attached sample files
Your assistance is immeasurable, thanks sir.

[SamT]

There's 2 ways:
The first uses Arrays

The easiest to understand just uses sheet Names
Open a book, Count the Rows, If there is NOT a sheet named #RowCount, Make one
Copy the Rows to Sheets(#RowCount)
Next book.

[akin]

Thanks
This look confusing to me as I just learning VBA. Sorry if it sound funny to you. Is there VBA code in the reply you sent, sir? If I understand you very well, you said I should use row count. I think should first use row count on the folder to separate the workbook before applying the script to merge. Thanks

[SamT]

I think should first use row count on the folder to separate the workbook before applying the script to merge.
Twice as slow and more than twice the work.

[Bob Phillips]

Sub CopyRange()
Const SHEET_PREFIX As String = "Rows "
Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet
Dim FolderName As String, Filename As String
Dim lastSource As Long, lastDest As Long
Dim startrow As Long
Dim starttime As Double

starttime = Timer

Application.ScreenUpdating = False

Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets(1)

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False
.Show
FolderName = .SelectedItems(1) & ""
End With

Filename = Dir(FolderName & Application.PathSeparator & "*.xls*")
Do While Filename <> vbNullString

If Filename <> wbDest.Name Then

Set wbSource = Workbooks.Open(FolderName & Application.PathSeparator & Filename)
With wbSource

With .Worksheets(1)

lastSource = .Cells(.Rows.Count, "A").End(xlUp).Row
If Not SheetExists(SHEET_PREFIX & lastSource - 1) Then

Set wsDest = wbDest.Worksheets.Add(after:=wbDest.Worksheets(wbDest.Worksheets.Count))
wsDest.Name = SHEET_PREFIX & lastSource - 1

startrow = 1
lastDest = 0
Else

lastSource = lastSource - 1 'don't duplicate header
Set wsDest = ThisWorkbook.Worksheets(SHEET_PREFIX & lastSource)
lastDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row

startrow = 2
End If

.Rows(startrow).Resize(lastSource).Copy wsDest.Cells(lastDest + 1, "A")
End With

.Close False
End With
End If

Filename = Dir
Loop

MsgBox "All done in " & Format(Timer - starttime, "0.000") & " secs"

Application.ScreenUpdating = True
End Sub

Private Function SheetExists(ByVal SheetName As String) As Boolean
Dim ws As Worksheet

On Error Resume Next
Set ws = ThisWorkbook.Worksheets(SheetName)

SheetExists = Not ws Is Nothing
End Function

[akin]

I very grateful for this post. I just check back today and found this. I had run the script. It just gave me the time it took to complete the task. When I checked the worksheet and folder, I could not find anything. Please what will it accomplish? Any need more revelation, please.Thanks

[Bob Phillips]

It does what you asked on the workbooks you provided.

[akin]

Thanks, sir. It does that amazingly. I tried it on another set of data and it did just that. You are such a gem, sir.

[akin]

Please, sir. I want to copy some line in the previous script up there and incorporate it with this one. The line is where the merge we copy along each file /worksheet and make put it in the entire first column. Thanks

[Bob Phillips]

Are you saying that you want to insert a column identifying the source workbook?

[akin]

Exactly, sir. The source workbook will fill the whole first column. Thanks

[akin]

I am yet to get the problem solved. I have tried all I could to copy few lines from the old script I have and merge it with the present one for it to create new column and insert source workbooks name, but it was not working; it keep giving me error messages. This has put a stop to my current analysis of the data I have at hand. Thanks