Xin code copi dữ liệu từ File nguồn chuyển sang File Đích (1 người xem)

[le_vis]

Dùng code Dựa vào số thứ tự của File nguồn để tự động copi ( Nghĩa là khi thêm hoặc bớt dữ liệu từ F_nguon thì F_dich tự động thay đổi theo) dữ liệu từ F_nguon sang F_dich theo biểu mẫu đã được định sẵn
( Dữ liệu cần copi khoảng 500 dòng - Hoặc code dùng hàm Vlookup)
Điều kiện : * F_nguon và F_dich cùng nằm trong 1 Fodo
* Khi copi Fodo chuyển qua máy khác hoặc qua ổ khác code vẫn chạy được bình thường - Mong các bạn giúp đỡ

 

[Kiều Mạnh]

Dùng code Dựa vào số thứ tự của File nguồn để tự động copi ( Nghĩa là khi thêm hoặc bớt dữ liệu từ F_nguon thì F_dich tự động thay đổi theo) dữ liệu từ F_nguon sang F_dich theo biểu mẫu đã được định sẵn
( Dữ liệu cần copi khoảng 500 dòng - Hoặc code dùng hàm Vlookup)
Điều kiện : * F_nguon và F_dich cùng nằm trong 1 Fodo
* Khi copi Fodo chuyển qua máy khác hoặc qua ổ khác code vẫn chạy được bình thường - Mong các bạn giúp đỡ

Mình Tập làm bằng VBA cho bạn xem có đúng ý không nha nều chưa được hồi âm lại
bài này làm bằng ADO cũng được những mình ko hiểu sao lại ko thích ADO nữa nên làm cho bạn bằng VBA

Sub Copy_FileNguon()
Application.ScreenUpdating = False
Dim nguon(), kq(), i&, j&, k&
Dim FileCanMo$, wb As Workbook
nguon = Range([C6], [C1048576].End(3)).Resize(, 5).Value
ReDim kq(1 To UBound(nguon, 1), 1 To UBound(nguon, 2))
For i = 1 To UBound(nguon, 1)
    If nguon(i, 3) <> "" Then
        k = k + 1
        For j = 1 To UBound(nguon, 2)
            kq(k, j) = nguon(i, j)
        Next
    End If
Next
FileCanMo = ThisWorkbook.Path & "\F_dich.xlsx"
For Each wb In Workbooks
    If wb.Name = "F_dich.xlsx" Then
        Exit Sub
    End If
Next
Workbooks.Open FileCanMo
With Workbooks("F_dich.xlsx")
    With Sheets("F_dich")
        Range("D6:D65536").ClearContents
        Range("D7").Resize(UBound(nguon, 1), 5) = kq
    End With
    .Close True
End With
Application.ScreenUpdating = True
End Sub

 

[Quang_Hải]

Mình Tập làm bằng VBA cho bạn xem có đúng ý không nha nều chưa được hồi âm lại
bài này làm bằng ADO cũng được những mình ko hiểu sao lại ko thích ADO nữa nên làm cho bạn bằng VBA

Sub Copy_FileNguon()
Application.ScreenUpdating = False
Dim nguon(), kq(), i&, j&, k&
Dim FileCanMo$, wb As Workbook
nguon = Range([C6], [C1048576].End(3)).Resize(, 5).Value
ReDim kq(1 To UBound(nguon, 1), 1 To UBound(nguon, 2))
For i = 1 To UBound(nguon, 1)
    If nguon(i, 3) <> "" Then
        k = k + 1
        For j = 1 To UBound(nguon, 2)
            kq(k, j) = nguon(i, j)
        Next
    End If
Next
FileCanMo = ThisWorkbook.Path & "\F_dich.xlsx"
For Each wb In Workbooks
    If wb.Name = "F_dich.xlsx" Then
        Exit Sub
    End If
Next
Workbooks.Open FileCanMo
With Workbooks("F_dich.xlsx")
    With Sheets("F_dich")
        Range("D6:D65536").ClearContents
        Range("D7").Resize(UBound(nguon, 1), 5) = kq
    End With
    .Close True
End With
Application.ScreenUpdating = True
End Sub

Viết sai búa xua luôn nghen. Mở With thì những gì liên quan phải có chấm đàng hoàng chứ.
Resize cũng lu xu bu nha

 

[Kiều Mạnh]

Viết sai búa xua luôn nghen. Mở With thì những gì liên quan phải có chấm đàng hoàng chứ.
Resize cũng lu xu bu nha

em test thấy nó vẫn chạy tốt mà

 

[le_vis]

Quả là không chạy được kieu manh ạ. nhờ bạn xem lại, Đồng thời Bạn xem giúp Mình đưa lên ví dụ 1 File đích : Nhưng mình muốn Cùng File nguồn có thể chỉ cần nhập dữ liệu vào thì tự động dữ liệu cùng lúc được cập nhật sang 12 File đích không cần phải có nút lệnh lưu nữa. Xin cảm ơn bạn đã quan tâm

 

[Quang_Hải]

Quả là không chạy được kieu manh ạ. nhờ bạn xem lại, đồng thời nếu không nhầm mình nhớ có 1 cách không cần thêm bất cứ thao tác nào. chỉ cần nhập liệu tại File nguồn thì File đích tự động nhận như thế tiện hơn nhiều bạn ơi. Bạn xem giúp nhé

Xem sơ qua thấy 2 file giống như đúc thì code chi cho nhức óc vậy ta?

 

[Kiều Mạnh]

Quả là không chạy được kieu manh ạ. nhờ bạn xem lại, đồng thời nếu không nhầm mình nhớ có 1 cách không cần thêm bất cứ thao tác nào. chỉ cần nhập liệu tại File nguồn thì File đích tự động nhận như thế tiện hơn nhiều bạn ơi. Bạn xem giúp nhé

sao vậy ta minh test nó vẫn chạy mà bạn phải đóng F_dich lại thì nó mới chạy bạn chấm thêm dấu chấm trước hai dòng code sau nha
còn cái khác để mình nghiên cứu xem nếu được mình làm cho

 Range("D6:D65536").ClearContents
Range("D7").Resize(UBound(nguon, 1), 5) = kq

 

[le_vis]

Bạn Quang Hai 1969 ơi . bạn có thể dành cho mình sự giúp đỡ nay không ? Mình muốn Cùng File nguồn có thể chỉ cần nhập dữ liệu vào thì tự động dữ liệu cùng lúc được cập nhật sang 12 File đích không cần phải có nút lệnh lưu nữa. Xin cảm ơn bạn đã quan tâm

 

[Quang_Hải]

sao vậy ta minh test nó vẫn chạy mà bạn phải đóng F_dich lại thì nó mới chạy bạn chấm thêm dấu chấm trước hai dòng code sau nha
còn cái khác để mình nghiên cứu xem nếu được mình làm cho

 Range("D6:D65536").ClearContents
Range("D7").Resize(UBound(nguon, 1), 5) = kq

Chơi kiểu này mới đích thực là bá đạo nè

Sub KaKaKa()
On Error Resume Next
Dim FileCanMo$
FileCanMo = ThisWorkbook.Path & "\F_dich.xlsx"
Workbooks("F_dich.xlsx").Close
With CreateObject("Scripting.FileSystemObject")
   .CopyFile ThisWorkbook.FullName, FileCanMo
End With
End Sub

 

[Quang_Hải]

Bạn Quang Hai 1969 ơi . bạn có thể dành cho mình sự giúp đỡ nay không ? Mình muốn Cùng File nguồn có thể chỉ cần nhập dữ liệu vào thì tự động dữ liệu cùng lúc được cập nhật sang 12 File đích không cần phải có nút lệnh lưu nữa. Xin cảm ơn bạn đã quan tâm

Hỏng lẽ gõ 1 cái thì cập nhật 12 file? Nghe hơi sao sao í. Nghĩ thử cái khác đi coi sao.

 

[Kiều Mạnh]

Chơi kiểu này mới đích thực là bá đạo nè

Sub KaKaKa()
On Error Resume Next
Dim FileCanMo$
FileCanMo = ThisWorkbook.Path & "\F_dich.xlsx"
Workbooks("F_dich.xlsx").Close
With CreateObject("Scripting.FileSystemObject")
   .CopyFile ThisWorkbook.FullName, FileCanMo
End With
End Sub

Em mới thử một cái xong mở F_dich lên nó báo hình sau

 

[Quang_Hải]

Em mới thử một cái xong mở F_dich lên nó báo hình sau

Nghe không hợp lý. Lý thuyết thì không có sai. Còn thực tế bên ấy thì ai biết đâu.

 

[Kiều Mạnh]

Nghe không hợp lý. Lý thuyết thì không có sai. Còn thực tế bên ấy thì ai biết đâu.

Em cũng ko biết hay máy của em nó khác

 

[Quang_Hải]

Em cũng ko biết hay máy của em nó khác

Đúng là không mở ra được. Phải lưu cùng dạng mở rộng là xlsm mới được