Option Explicit
Sub LayDulieu()
Dim fd As Workbook, sd As Worksheet, sn As Worksheet, mn, md
Dim lrd As Long, lrd1 As Long, lrn As Long, i As Long, j As Long, k As Long, p As Long, q As Long, r As Long, s As Long, ktts As Long, tensheet As Long, icd As Long
Dim chonFile, openfile
Dim da_te As Date
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If UserForm1.TextBox1.Value <> "" Then
Set fd = ThisWorkbook
'Mo thuoc tinh File Open
chonFile = Application.GetOpenFilename(Title:="Chon file du lieu can lay", filefilter:="exel file(*.xls*),*.xls*", MultiSelect:=True)
On Error Resume Next
For i = 1 To UBound(chonFile)
On Error GoTo 0
If i = 0 Then Exit Sub
Set openfile = Workbooks.Open(chonFile(i), False)
With openfile
For ktts = 1 To Sheets.Count 'Kiem tra xem file co ten sheets can lay du lieu khong
If Sheets(ktts).Name = "BanHang" Then
tensheet = tensheet + 1
Exit For
End If
Next ktts
If tensheet = 0 Then 'Neu file khong co ten sheet nao giong thi dong file và thoát khoi Sub
openfile.Close
MsgBox "Khong co sheets nào giông tên sheet cân lay du lieu, vui long chon lai file khac"
GoTo thoat
End If
If UserForm1.TextBox1.Value <> "" Then
Set sd = fd.Sheets("BanHang")
If sd.AutoFilterMode = True Then sd.AutoFilterMode = False
lrd = sd.Cells(Rows.Count, 3).End(xlUp).Row
'sd.Cells(1, 8) = sd.Name
Set sn = openfile.Sheets("BanHang")
' sn.Unprotect
If sn.AutoFilterMode = True Then sn.AutoFilterMode = False
lrn = sn.Cells(Rows.Count, 3).End(xlUp).Row
mn = sn.Range("A6:P" & lrn)
ReDim md(1 To lrn - 5, 1 To 16)
da_te = convStandardDate(UserForm1.TextBox1, 1, "/")
r = 0
For q = 1 To lrn - 5
If IsDate(mn(q, 3)) Then
If mn(q, 3) >= da_te Then
r = r + 1
For s = 1 To 16
md(r, s) = mn(q, s)
Next s
End If
End If
Next q
If r > 0 Then sd.Range("A" & lrd + 1).Resize(r, 16) = md
' sd.Range("A" & lrd + 1).Resize(r, 16).Borders.LineStyle = True
lrd = sd.Cells(Rows.Count, 3).End(xlUp).Row
' sd.Range("A1:P1").Columns.AutoFit
End If
End With
openfile.Close
'fd.Save
thoat:
Next i
Else
MsgBox "Ban chua chon ngày, vui lòng chon lai"
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
