akin
06-26-2021, 01:00 PM
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.
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.