Sub Import_Data()
Dim shMain As Worksheet, sh As Worksheet
Dim wb As Workbook
Dim strFolderPath As String
Dim selectedFiles As Variant, sCol As Variant
Dim sArr(), Res1(), Res2(), eRow As Integer, i As Integer, k As Integer, j As Integer
Dim iFileNum As Integer
Dim startTime As Double
getSpeed (True)
eRow = Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then
Range("B3:E" & eRow).ClearContents
Range("G3:H" & eRow).ClearContents
End If
sCol = Array("", 2, 8, 27, 37, "", 40, 41)
Set shMain = ActiveWorkbook.Sheets("List BB")
strFolderPath = ActiveWorkbook.Path
ChDrive strFolderPath
ChDir strFolderPath
On Error GoTo NoFileSelected
selectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xlsx*,*.xlsm*,*.xlsb*", MultiSelect:=True)
'startTime = Timer
For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
Set wb = Workbooks.Open(selectedFiles(iFileNum))
For Each sh In wb.Sheets
If sh.Name Like "*VoVa" Then
eRow = sh.Range("A" & Rows.Count).End(xlUp).Row
If eRow > 2 Then
sArr = sh.Range("D3:AR" & eRow).Value
ReDim Res1(LBound(sArr) To UBound(sArr), 1 To 4)
ReDim Res2(LBound(sArr) To UBound(sArr), 1 To 2)
k = 0
For i = LBound(sArr) To UBound(sArr)
If Len(sArr(i, 2)) Then
If Len(sArr(i, 1)) = 0 Then
k = k + 1
For j = 1 To 4
Res1(k, j) = sArr(i, sCol(j))
Next j
Res2(k, 1) = sArr(i, sCol(6))
Res2(k, 2) = sArr(i, sCol(7))
End If
End If
Next i
End If
If k Then
eRow = shMain.Range("B" & Rows.Count).End(xlUp).Row
If eRow < 3 Then eRow = 3 Else eRow = eRow + 2
shMain.Range("B" & eRow).Resize(k, 4) = Res1
shMain.Range("G" & eRow).Resize(k, 2) = Res2
End If
End If
Next sh
wb.Close savechanges:=False
Next
'MsgBox "Done in " & Int(Timer - startTime) & " s."
getSpeed (False)
NoFileSelected:
'MsgBox "Chu*a có File nào duoc chon!"
End Sub
