Public Sub GetData()
Dim srcFolder As String
Dim srcFile As String
Dim curRow As Integer
Dim rowCnt As Integer
Dim srcBook As Workbook
Dim srcSheet As Worksheet
Dim desBook As Workbook
Dim desSheet As Worksheet
Dim srcSheetName As String
Dim listSheetName() As String
Dim startRow As Integer
Dim startCol As String
Dim endCol As String
Dim i As Integer
srcFolder = GetFolder(Application.Path)
srcFile = Dir(srcFolder & "\*.xls?")
srcSheetName = InputBox("Nhap sheet can tong hop")
startRow = InputBox("Nhap dong bat dau")
startCol = InputBox("Nhap cot bat dau")
endCol = InputBox("Nhap cot ket thuc")
listSheetName = Split(srcSheetName, ";")
Set desBook = ActiveWorkbook
For i = LBound(listSheetName) To UBound(listSheetName)
Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For i = LBound(listSheetName) To UBound(listSheetName)
Set desSheet = CreateSheet(desBook, "Result - " & listSheetName(i))
curRow = 1
Do While srcFile <> ""
If ActiveWorkbook.Name <> srcFile Then
Set srcBook = Workbooks.Open(srcFolder & "\" & srcFile)
Set srcSheet = srcBook.Sheets(Trim(listSheetName(i)))
rowCnt = startRow
Do While srcSheet.Range(startCol & Trim(Str(rowCnt + 1))).Value <> ""
rowCnt = rowCnt + 1
Loop
rowCnt = rowCnt - startRow
srcSheet.Activate
srcSheet.Range(startCol & Trim(Str(startRow)) & ":" & endCol & Trim(Str(startRow + rowCnt - 1))).Select
Selection.Copy
desBook.Activate
desSheet.Select
desSheet.Range("B" & Trim(Str(curRow))).Select
desSheet.Paste
desSheet.Range("A" & Trim(Str(curRow)) & ":A" & Trim(Str(curRow + rowCnt - 1))).Value = srcFile
curRow = curRow + rowCnt
srcBook.Close
End If
srcFile = Dir
Loop
srcFile = Dir(srcFolder & "\*.xls?")
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Function CreateSheet(wb As Workbook, sheetName As String) As Worksheet
On Error Resume Next
Dim oldAlert As Boolean
oldAlert = Application.DisplayAlerts
Application.DisplayAlerts = False
wb.Sheets(sheetName).Delete
Application.DisplayAlerts = oldAlert
Set CreateSheet = wb.Sheets.Add(After:=Sheets(Sheets.Count))
CreateSheet.Name = sheetName
On Error GoTo -1
End Function
