File đính kèm
Lần chỉnh sửa cuối:
oh, cảm ơn bạn, mình không chú ý đến vụ tên thư mục là tiếng việt có dấu.Đường dẫn của file là tiếng việt nên bị vậy
Ngoài lỗi đường dẫn tiếng việt thì còn khả năng nào nữa không vậy bạn, hôm nay mình gởi file cho 3 người, 3 người đều bị lỗi không xuất sheet 2 ra thành file mới được, nó báo lỗi, mà chắc chắn là họ lưu ở Download, nên đường dẫn không thể là tiếng việt đượcĐường dẫn của file là tiếng việt nên bị vậy
Trên máy tôi thì code chạy bình thường. Để tôi viết lại cách khác thử có hết lỗi khôngNgoài lỗi đường dẫn tiếng việt thì còn khả năng nào nữa không vậy bạn, hôm nay mình gởi file cho 3 người, 3 người đều bị lỗi không xuất sheet 2 ra thành file mới được, nó báo lỗi, mà chắc chắn là họ lưu ở Download, nên đường dẫn không thể là tiếng việt được
View attachment 264121
Sub Export_Sheet()
Dim wb As Workbook
Dim ws As Worksheet
Dim currentPath As String
currentPath = Application.ActiveWorkbook.Path
Calculate
ThisWorkbook.Save
Sheet2.Range("A1:I1000").ClearContents
Sheet2.Range("A1:I1000") = Sheet2.Range("BZ3:CH1002").Value
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Sheet2.Copy ' nó báo lỗi dòng này
ActiveSheet.Name = "Sheet1"
ActiveSheet.Range("J1:CH1010").Delete
ActiveSheet.Range("J1:CH1010").ClearContents
ActiveSheet.Range("A:I").ColumnWidth = 10
ActiveWorkbook.Close True, currentPath & "\ " & Sheet1.Range("B1") & " " & Format(Now(), "dd.MM.YYYY") & ".xlsx"
.DisplayAlerts = True
.ScreenUpdating = True
End With
ThisWorkbook.Save
MsgBox "Da luu thanh file Bài thi kien thuc tháng " & Format(Now(), "MM.YYYY") & ".xlsx" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Luu trong cùng thu muc voi File này." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Vui lòng vào he thong AIS de upload ", , "Thông báo : "
Shell "Explorer.exe" & " " & ThisWorkbook.Path, vbNormalFocus
End Sub
Sub Export_Sheet()
Dim wb As Workbook, wbNew As Workbook
Dim ws As Worksheet
Dim currentPath As String
currentPath = Application.ActiveWorkbook.Path
Calculate
ThisWorkbook.Save
Set wb = ThisWorkbook
Sheet2.Range("A1:I1000").ClearContents
Sheet2.Range("A1:I1000") = Sheet2.Range("BZ3:CH1002").Value
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Set wbNew = Workbooks.Add
wb.Sheets("UPLOAD").Range("A1:I1000").Copy wbNew.Sheets("Sheet1").Range("A1")
Range("A:I").ColumnWidth = 10
wbNew.Close True, currentPath & "\" & "Bài thi kien thuc tháng " & Format(Now(), "dd.MM.YYYY") & ".xlsx"
.DisplayAlerts = True
.ScreenUpdating = True
End With
wb.Save
MsgBox "Da luu thanh file " & vbNewLine & "Bài thi kien thuc tháng " & Format(Now(), "MM.YYYY") & ".xlsx" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Luu trong cùng thu muc voi File này." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Vui lòng vào he thong AIS de upload ", , "Thông báo : "
Shell "Explorer.exe" & " " & ThisWorkbook.Path, vbNormalFocus
Set wb = Nothing: Set wbNew = Nothing
End Sub
được rồi bạn ạ, bạn quá siêu luôn , hihihii@alex-luu
Bạn thay code cũ bằng code này xem sao
Rich (BB code):Sub Export_Sheet() Dim wb As Workbook, wbNew As Workbook Dim ws As Worksheet Dim currentPath As String currentPath = Application.ActiveWorkbook.Path Calculate ThisWorkbook.Save Set wb = ThisWorkbook Sheet2.Range("A1:I1000").ClearContents Sheet2.Range("A1:I1000") = Sheet2.Range("BZ3:CH1002").Value With Application .ScreenUpdating = False .DisplayAlerts = False Set wbNew = Workbooks.Add wb.Sheets("UPLOAD").Range("A1:I1000").Copy wbNew.Sheets("Sheet1").Range("A1") Range("A:I").ColumnWidth = 10 wbNew.Close True, currentPath & "\" & "Bài thi kien thuc tháng " & Format(Now(), "dd.MM.YYYY") & ".xlsx" .DisplayAlerts = True .ScreenUpdating = True End With wb.Save MsgBox "Da luu thanh file " & vbNewLine & "Bài thi kien thuc tháng " & Format(Now(), "MM.YYYY") & ".xlsx" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Luu trong cùng thu muc voi File này." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Vui lòng vào he thong AIS de upload ", , "Thông báo : " Shell "Explorer.exe" & " " & ThisWorkbook.Path, vbNormalFocus Set wb = Nothing: Set wbNew = Nothing End Sub
@3ii
Bạn xem trong code này thử có gì dùng cho bạn được không. Tôi nghĩ vấn đề ở chỗ dùng Sheet2.Copy để chép thẳng Sheet2 ra 1 New Workbook sẽ gây lỗi.
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2