Copy sheet sang file khác nằm ở thư mục khác nhau.

Liên hệ QC

hongphuong1997

Thành viên tiêu biểu
Tham gia
12/11/17
Bài viết
737
Được thích
300
Giới tính
Nữ
Em nhờ các Bác và các anh chị viết giúp em code như file đính kèm ạ.
Em cảm ơn ạ
 

File đính kèm

  • Vật tư.xlsx
    46 KB · Đọc: 15
Thử code này:
Mã:
Option Explicit

Sub Tong_hop_sang_file_khac()

Dim wsName As String, mainLr As Long, dPath As String, mainRng As Range
Dim mainWb As Workbook, newWb As Workbook, mainWs As Worksheet, newWs As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
'***************************************************************************
dPath = "C:\Users\admin\Desktop\Du_an\TH_Vat_tu.xlsx" ' => Chi sua path o day neu thay doi
Set mainWb = ThisWorkbook
Set mainWs = mainWb.Sheets("Tonghop")
'***************************************************************************
mainLr = mainWs.Cells(Rows.Count, "B").End(xlUp).Row
wsName = Format(Date, "dd-mm-yyyy")
Set mainRng = mainWs.Range("A1:E" & mainLr)
'***************************************************************************
Set newWb = Workbooks.Open(dPath)
On Error Resume Next
    newWb.Sheets(wsName).Copy after:=newWb.Sheets(newWb.Sheets.Count)
    If Err.Number > 0 Then
        Set newWs = newWb.Sheets.Add
        newWs.Name = wsName
    Else
        Set newWs = ActiveSheet
        newWs.Cells.Clear
    End If
On Error GoTo 0
'***************************************************************************
    With newWs
        mainRng.Copy .Cells(1, 1)
        .Columns("A:E").AutoFit
        .Rows("1:" & mainLr).AutoFit
        newWb.Close True
    End With
'***************************************************************************
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
Anh ơi, code chạy quá chuẩn và rất nhanh anh oi
Nhưng sao code này anh viết hơi bị khó hiểu một chút
Anh làm ơn giải thích giúp em từng dòng lệnh với anh nhé.
Và anh thêm cho em cái cảnh báo là "Sheet đã có, có tiếp tục không" cho em với
Em cảm ơn anh ạ!
Chúc anh măm măm ngon miệng anh nhé.
Bài đã được tự động gộp:

Bạn copy cả 2 file và thư mục D:\TH_du an\ và chạy thử xem đúng ý chưa?

@ngocbaovu

Bây giờ em mới Test được code của anh
Code chạy rất chuẩn anh ah
Em cảm ơn anh rất chiều ạ
Em chúc anh buổi tối tràn đầy vui vẻ anh nhé!
 
Lần chỉnh sửa cuối:
Upvote 0
Anh làm ơn giải thích giúp em từng dòng lệnh với anh nhé.
Chỗ này không hiểu đâu thì hỏi chứ cả bài mất thời gian lắm
Và anh thêm cho em cái cảnh báo là "Sheet đã có, có tiếp tục không" cho em với
Gợi ý là dòng đó để sau câu lệnh Else, còn viết sao thì tự ngẫm. Cái tội không nói từ đầu

Phần bạn khó hiểu thì chắc chủ yếu ở khúc tạo nếu sheet đã có vẫn copy. Cơ bản thì code trên không dùng vòng lặp duyệt sheet như code cũ mà nó sẽ copy "đại" cái tên sheet đó thành sheet mới. Thì lúc đó có hai khả năng xảy ra, sheet chưa có hoặc có rồi. Nếu chưa có sẽ bị lỗi do vậy bẫy lỗi on error resume next cho code cứ chạy nếu lỗi. Sau đó có err.number>0 tức là có lỗi -> Có lỗi là do chưa có tên sheet đó thì cứ tạo sheet mới bình thường. Còn chỗ else tức là không xảy ra lỗi, nghĩa là sheet đó tồn tại, thì copy sheet đó thành sheet mới, xóa nội dung (clear) của sheet đó. Sau khi xử lý xong phần đó thì cài on error goto 0 để trả lại như trước khi bẫy lỗi. Hết khúc khó hiểu
 
Upvote 0
Chỗ này không hiểu đâu thì hỏi chứ cả bài mất thời gian lắm

Gợi ý là dòng đó để sau câu lệnh Else, còn viết sao thì tự ngẫm. Cái tội không nói từ đầu

Phần bạn khó hiểu thì chắc chủ yếu ở khúc tạo nếu sheet đã có vẫn copy. Cơ bản thì code trên không dùng vòng lặp duyệt sheet như code cũ mà nó sẽ copy "đại" cái tên sheet đó thành sheet mới. Thì lúc đó có hai khả năng xảy ra, sheet chưa có hoặc có rồi. Nếu chưa có sẽ bị lỗi do vậy bẫy lỗi on error resume next cho code cứ chạy nếu lỗi. Sau đó có err.number>0 tức là có lỗi -> Có lỗi là do chưa có tên sheet đó thì cứ tạo sheet mới bình thường. Còn chỗ else tức là không xảy ra lỗi, nghĩa là sheet đó tồn tại, thì copy sheet đó thành sheet mới, xóa nội dung (clear) của sheet đó. Sau khi xử lý xong phần đó thì cài on error goto 0 để trả lại như trước khi bẫy lỗi. Hết khúc khó hiểu
Cảm ơn anh ạ
Chịu thoi
 
Upvote 0
Web KT
Back
Top Bottom