[COLOR=#000000]Sub update()[/COLOR] Dim cn As Object, rs As Object, arr, lastrow As Integer, wb As Workbook
Dim Tmp, i As Integer
Application.ScreenUpdating = False
lastrow = Range("C65000").End(3).Row
arr = Range("C7:C" & lastrow).Value
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
Set dic = CreateObject("Scripting.Dictionary")
With dic
For i = 1 To UBound(arr)
Tmp = arr(i, 1)
If Not .exists(Tmp) Then
.Add Tmp, i
if dir([FONT=Verdana]ThisWorkbook.Path & "\" & Tmp & ".xls"[/FONT][FONT=Verdana]) <> "" then[/FONT] Set rs = cn.Execute("select f1, f4, f6, f7, f8, f10 from [Tong hop$B7:K] where f2 like '" & Tmp & "'")
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Tmp & ".xls")
wb.Sheets("Bao duong sua chua").Range("A4").CopyFromRecordset rs
rs.Close
wb.Close True
end if
End If
Next
End With
cn.Close: Set cn = Nothing: Set rs = Nothing: Set dic = Nothing
Application.ScreenUpdating = True
End Sub
