Xin chỉ thêm code theo vùng chỉ định từ file này sang file khác ? (1 người xem)

[nqdn2010]

Vấn đề này em xem rất nhiều bài trên diễn đàn nhưng không tìm thấy bài để giải quyết triệt để vấn đề của em.
Em có gởi file đính kèm, trong đó có đoạn code rất hay em chép được từ diễn đàn và chế biến để được yêu cầu sau:
Khi Click vào nút lệnh theo những yêu cầu sau:
1. Copy sheet "a1" và "a2" sang file mới tùy ý.
2. Sheet "a1" và "a2" ở file mới giữ nguyên định dạng dòng, cột và không chứa công thức.
3. Chỉ copy 1 vùng nhất định từ sheet "a1" và "a2" của file nguồn sang.
(VD: Ở sheet "a1" chỉ copy vùng (A120); Ở sheet "a2" chỉ copy vùng (B515) )
Code trong file này giải quyết tuyệt vời vấn đề 1 và 2; Tuy nhiên vấn đề 3 em vọc hoài không ra .
Mong sự giúp đỡ của các Anh, Chị. Thank!

 

[nqdn2010]

Vấn đề này em xem rất nhiều bài trên diễn đàn nhưng không tìm thấy bài để giải quyết triệt để vấn đề của em.
Em có gởi file đính kèm, trong đó có đoạn code rất hay em chép được từ diễn đàn và chế biến để được yêu cầu sau:
Khi Click vào nút lệnh theo những yêu cầu sau:
1. Copy sheet "a1" và "a2" sang file mới tùy ý.
2. Sheet "a1" và "a2" ở file mới giữ nguyên định dạng dòng, cột và không chứa công thức.
3. Chỉ copy 1 vùng nhất định từ sheet "a1" và "a2" của file nguồn sang.
(VD: Ở sheet "a1" chỉ copy vùng (A120); Ở sheet "a2" chỉ copy vùng (B515) )
Code trong file này giải quyết tuyệt vời vấn đề 1 và 2; Tuy nhiên vấn đề 3 em vọc hoài không ra .
Mong sự giúp đỡ của các Anh, Chị. Thank!

 

[nqdn2010]

Không biết trên diễn đàn có Toppic nào trùng vấn đền này không? Nếu trùng rất mong các thành viên chỉ đường link, tôi cám ơn nhiều!

 

[phucbugis]

bạn thử đoạn code sau cho vấn đề 3:

Sub Button1_Click()
Dim WB As Workbook
Set WB = Workbooks("file nguon (1).xlsm")

    Workbooks.Add
    Sheets("Sheet1").Name = "a1"
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet2").Name = "a2"
    
    With ActiveWorkbook
        .Sheets("a1").Range("A1:D20") = WB.Sheets("a1").[A1:D20].Value
        .Sheets("a2").Range("B5:D15") = WB.Sheets("a2").[B5:D15].Value
    End With
    
    Set WB = Nothing
End Sub

 

[nqdn2010]

Do bận công việc, Tôi sẽ text sau mong bạn thông cảm. Cám ơn sự quan tâm của bạn.

 

[nqdn2010]

Cám ơn bạn!
Chỉnh lại Set WB = Workbooks("file nguon (1).xlsm") thành Set WB = Workbooks("file nguon ") hoạt động tốt.

 

[nqdn2010]

bạn thử đoạn code sau cho vấn đề 3:

Sub Button1_Click()
Dim WB As Workbook
Set WB = Workbooks("file nguon (1).xlsm")

    Workbooks.Add
    Sheets("Sheet1").Name = "a1"
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet2").Name = "a2"
    
    With ActiveWorkbook
        .Sheets("a1").Range("A1:D20") = WB.Sheets("a1").[A1:D20].Value
        .Sheets("a2").Range("B5:D15") = WB.Sheets("a2").[B5:D15].Value
    End With
    
    Set WB = Nothing
End Sub

- Code này không thỏa mãn vấn đề 2 (giữ nguyên định dạng kể cả khung kẻ và chỉ không chứa công thức)
Bạn có thể chỉnh code để khi Click nút lệnh sẽ có thông báo chỉ đường dẫn lưu và cách thức lưu (*.xls; *.xlsm; . . .) đồng thời thỏa mãn vấn đề 2.
Cám ơn bạn nhiều!

 

[nqdn2010]

Rất mong sự chỉ giáo của Các bạn!!!