Copy một vùng từ một tập tin Excel - Copy a range from closed workbook

[levanduyet]

Nguồn tại đây.

Copy một vùng từ một tập tin Excel (đóng) (Closed Workbook)
Tập tin này có thể ở mạng thư mục trên mạng nội bộ, hoặc trên internet.

Tất cả các ví dụ đều dùng macro GetRange.
Với macro này bạn có thể lấy nội dung từ:

1. Tập tin trên internet (giả sử trên một site nào đó).
2. Tập tin trên một thư mục trong mạng nội bộ.
3. Tập tin trên một thư mục của máy thực hiện macro này.

Sau đây là các links hữu ích liên quan đến vấn đề này :

1. Link 1.
2. Link 2.
3. Link 3.

Có 5 đối số cho macro là:

1. Đường dẫn (Path)
2. Tên tập tin (File name)
3. Tên sheet nguồn (Source sheet name)
4. Vùng nguồn (Source range)
5. Sheet đích (Destination sheet/range)

Chú ý: Ở đây chưa có đoạn mã bẫy lỗi trong trường hợp tập tin hay tên sheet không tồn tại.
Ví dụ 1.

Sub File_On_Website()
    Application.ScreenUpdating = False
    On Error Resume Next
    'Call the macro GetRange
    GetRange "http://www.rondebruin.nl/files", "test1.xls", "Sheet1", "A1:B100", _
             Sheets("Sheet1").Range("A1")
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Ví dụ 2.

Sub File_In_Network_Folder()
    Application.ScreenUpdating = False
    On Error Resume Next
    'Call the macro GetRange
    GetRange "\\Jdb\shareddocs", "test2.xls", "Sheet1", "A1:B100", _
             Sheets("Sheet1").Range("A1")
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Ví dụ 3.

Sub File_In_Local_Folder()
    Application.ScreenUpdating = False
    On Error Resume Next
    'Call the macro GetRange
    GetRange "C:\Data", "test3.xls", "Sheet1", "A1:B100", _
             Sheets("Sheet1").Range("A1")
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Thủ tục chính:

Sub GetRange(FilePath As String, FileName As String, SheetName As String, _
             SourceRange As String, DestRange As Range)
    Dim Start
    'Đi đến vùng đích (destination)
    Application.Goto DestRange

    'Thay đổi kích thước vùng DestRange cho giống với vùng SourceRange
    Set DestRange = DestRange.Resize(Range(SourceRange).Rows.Count, _
                                     Range(SourceRange).Columns.Count)

    'Thêm công thức links đến tập tin đóng này
    With DestRange
        .FormulaArray = "='" & FilePath & "/[" & FileName & "]" & SheetName _
                        & "'!" & SourceRange

        'Chờ
        Start = Timer
        Do While Timer < Start + 2
            DoEvents
        Loop

        'Chuyển các giá trị từ công thức
        .Copy
        .PasteSpecial xlPasteValues
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
End Sub