hongphuong1997
Thành viên tiêu biểu
- Tham gia
- 12/11/17
- Bài viết
- 771
- Được thích
- 321
- Giới tính
- Nữ
Anh ơi, code chạy quá chuẩn và rất nhanh anh oiThử 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
Bạn copy cả 2 file và thư mục D:\TH_du an\ và chạy thử xem đúng ý chưa?
Chỗ này không hiểu đâu thì hỏi chứ cả bài mất thời gian lắmAnh làm ơn giải thích giúp em từng dòng lệnh với anh nhé.
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ừ đầuVà 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
Cảm ơn anh ạ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