Code VBA copy sheet để lưu trữ theo ngày (1 người xem)

[Pannilly]

Dear các anh chị,

Em có theo dõi một chủ đề hướng dẫn viết code trong topic này

http://www.giaiphapexcel.com/forum/...-sheets-của-file-dang-mo-sang-file-khác/page2

E chưa học gì về VBA, nên mày mò thử trên forum mình xem có giải pháp nào không thì thấy có một case cũng tương tự, e cũng muốn copy dữ liệu một sheet sang một file khác để lưu trữ theo ngày, e có gửi 2 file đính kèm ah. Mọi người có thể hướng dẫn giúp e được không ah.

https://drive.google.com/file/d/0B7dKlGziEgrdZlp5RGdKaVZreU0/view?usp=sharing

Mỗi ngày e sẽ update data trong file Data_So_GDCK, em muốn copy value nguyên sheet HOSE_GD (file này sẽ thay đổi dữ liệu mỗi ngày) sang file GDNN_HOSE và đặt tên file theo cấu trúc 11.10.16. Em muốn lưu trữ theo sheet (mỗi sheet là 1 ngày) trong file GDNN_HOSE.

Em cám ơn anh chị nhiều.

Em An.

 

[giaiphap]

Dear các anh chị,

Em có theo dõi một chủ đề hướng dẫn viết code trong topic này

http://www.giaiphapexcel.com/forum/...-sheets-của-file-dang-mo-sang-file-khác/page2

E chưa học gì về VBA, nên mày mò thử trên forum mình xem có giải pháp nào không thì thấy có một case cũng tương tự, e cũng muốn copy dữ liệu một sheet sang một file khác để lưu trữ theo ngày, e có gửi 2 file đính kèm ah. Mọi người có thể hướng dẫn giúp e được không ah.

https://drive.google.com/file/d/0B7dKlGziEgrdZlp5RGdKaVZreU0/view?usp=sharing

Mỗi ngày e sẽ update data trong file Data_So_GDCK, em muốn copy value nguyên sheet HOSE_GD (file này sẽ thay đổi dữ liệu mỗi ngày) sang file GDNN_HOSE và đặt tên file theo cấu trúc 11.10.16. Em muốn lưu trữ theo sheet (mỗi sheet là 1 ngày) trong file GDNN_HOSE.

Em cám ơn anh chị nhiều.

Em An.

Bạn thay đoạn code của bạn thành thế này thử xem.

Option Explicit
Sub Copy_PasteFileDong2() ''Minh viet cho ban 2 trong mot
Application.ScreenUpdating = False
Dim nguon(), Wh As Workbook, OpenFile As String


OpenFile = ThisWorkbook.Path & "\GDNN_HOSE.xlsx"
nguon = Range([A1], [A65536].End(3)).Resize(, 26).Value
For Each Wh In Workbooks
    If Wh.Name <> ThisWorkbook.Name Then
        Wh.Close savechanges:=False
    End If
Next Wh


Workbooks.Open OpenFile
If KTra(Replace(Sheet1.[b5], "/", ".")) = False Then
    With Workbooks("GDNN_HOSE.xlsx")
        .Sheets.Add After:=Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
            .UsedRange.ClearContents '''Neu xoa dong nay di thi copy moi duoi nhau_Con ko thi nguoc lai
            .[A65536].End(3).Resize(UBound(nguon), 26) = nguon
        End With
        Sheets(Sheets.Count).Name = Replace(Sheet1.[b5], "/", ".")
        .Close True
    End With
    MsgBox "Ngay " & Sheet1.[b5] & " da luu xong!"
Else
    MsgBox "Xin loi! ngay " & Sheet1.[b5] & " da duoc luu roi"
    Workbooks("GDNN_HOSE.xlsx").Close False
End If
Application.ScreenUpdating = True
End Sub


Public Function KTra(s As String) As Boolean
On Error Resume Next
    KTra = CBool(Len(Worksheets(s).Name) > 0)
End Function

 

[Pannilly]

Vâng, e đã chạy thử và ok rồi ah, e cám ơn nhiều lắm ah. E sẽ bắt chước code này cho các sheet còn lại ah.