Copy dữ liệu từ file đóng qua file đang mở ? (1 người xem)

[thikb219]

Em có 2 file excel file 1 : book12 và file 2 : HN450
Bây giờ em muốn copy dữ liệu từ file : HN450 sang file book12 mà không cần mở file HN450
Em có dùng đoạn code bên dưới tham khảo từ diễn đàn nhưng tốc đọ copy chậm quá vì file book12 của mình tới hơn 7000 ngàn dòng lận, mong mọi người chỉ giáo dùm cho.
Thank trước nha.


Option Explicit
Sub Test()
Dim sFile As String, sSheet As String, sAddr As String
Sheet1.Activate
Range(Cells(3, 1), Cells(65000, 8)).ClearContents

If Sheet4.Cells(4, 19).Value = "HCM-350" Then
sFile = "C:\dutoan\HCM350\350hcm.xls" ' ten file can lay du lieu vao phan mem
sSheet = "dongia" ' ten sheet can lay du lieu vao
sAddr = "A3:g7400" ' o nay va o duoi phai bang nhau
Sheets("dongia").Range("A3:g7400") = GetData(sFile, sSheet, sAddr)
ElseIf Sheet4.Cells(4, 19).Value = "HN-450" Then
sFile = "C:\dutoan\HN450\HN450.xls" ' ten file can lay du lieu vao phan mem
sSheet = "dongia" ' ten sheet can lay du lieu vao
sAddr = "A3:g5828" ' o nay va o duoi phai bang nhau
Sheets("dongia").Range("A3:g5828") = GetData(sFile, sSheet, sAddr)
End If
'ActiveSheet.Paste Link:=True
End Sub
Function GetData(sFile As String, sSheet As String, sAddr As String)
Dim pLink As String, iR As Long, iC As Long, Arr
If Len(Dir(sFile)) Then
Arr = Range(sAddr)
pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"
For iR = 1 To Range(sAddr).Rows.Count
For iC = 1 To Range(sAddr).Columns.Count
Arr(iR, iC) = ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, iC).Address(, , 2))
Next iC
Next iR
GetData = Arr
End If
End Function

 

[be_09]

Em sử dụng File này thử.
cách sử dụng ở sheet hướng dẫn

 

[thikb219]

Hỏi cách copy

A có cach nào mà mình không cần mở file đó lên mà vẫn có thể chèn thêm sheets cần copy vào sheets tổng được không a?
Thank anh nhiều

 

[dhn46]

Bạn dungf Code sau nhé. Vấn đề lấy dữ liệu từ file đóng thì ADO là một giải pháp khá hay, bạn có thể tìm hiểu thêm về vấn đề này

Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    Application.ScreenUpdating = False
    'Mo hop thoai chon file
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "DHN46 - Thong bao"
            Exit Sub
        End If
        'Duyet qua cac file duoc chon
        For Each Fname In .SelectedItems
            'Tao ket noi CSDL
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
            End With
            'Cau lenh truy van
            lsSQL = "SELECT * FROM [dongia$A2:G65536] WHERE f2 is not Null"
            lrs.Open lsSQL, cnn, 3, 1
            'Copy ket qua vao sheet Tong hop
            Sheet1.Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
            cnn.Close
        Next
    End With
    Application.ScreenUpdating = True
    Set lrs = Nothing
    Set cnn = Nothing
End Sub

 

[thikb219]

Em cảm ơn mọi người nhiều với code trên em đã làm được cái mình mong muốn
Em có một vấn đề nữa muốn hỏi "
"CopyFromRecordset" thì nó copy giống như copy value của excel có cách nào để nó copy mà vẫn giữ nguyên đường link của file
gốc không mấy anh
Thank mọi người nhiều!
CopyFromRecordset

 

[thikb219]

Copy link trong ado help???

có cach nào copy bang ado "sheet1.Range("a65536").End(3).Offset(2, 0).CopyFromRecordset lrs"
mà vấn dữ nguyên đường link không mọi người giúp mình với

 

[ndu96081631]

có cach nào copy bang ado "sheet1.Range("a65536").End(3).Offset(2, 0).CopyFromRecordset lrs"
mà vấn dữ nguyên đường link không mọi người giúp mình với

Đã copy là người ta muốn lấy giá trị. Bạn muốn có đường link gì đó, thôi thì gõ công thức vào đi
(mà chắc cũng chẳng ai làm vậy với dữ liệu lớn cả)