Code tách sheet thành 01 file mới rồi vào lưu vào đường dẫn có sẵn (1 người xem)

huonglien1901 · 20/10/18

Chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

em có nhiều file xuất từ phần mềm ra,
em muốn dựa vào cột Zone và cột Alley(2 CỘT NÀY ĐỂ GHÉP LẠI TẠO TÊN FILE) để tách file.

Ví dụ: Zone: A, Alley: 01-------> ghép lại tạo tên file là A01

những file mới tạo ra lưu thành vào đường dẫn có sẵn:
Ví dụ: C:\Users\Administrator\Downloads\Documents: những file mới vừa tạo lưu thành 01 folder riêng(sẽ lưu trong đường dẫn này)
Folder A: sẽ chứa những file có tên là A01,A02............
folder B: sẽ chưa những file có tên là: B01,B02.....
Yêu cầu 1: Em muốn tách sheet thành file và lưu với tên dựa vào điều kiện (cột Zone, cột Alley.)
Yêu cầu2: Khi em copy dữ liệu vào dữ liệu cũ sẽ xóa đi.
yêu cầu 3: khi em copy dữ liệu dán vào thì tự động căn chỉnh dòng và cột.
yêu cầu 4: tạo nút Print hoặc xem trước và in tự động các file này.

Em cảm ơn mọi người nhiều!

giaiphap · 21/10/18

huonglien1901 đã viết:
Chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

em có một file xuất từ phần mềm ra,
em muốn dựa vào cột Zone và cột Alley(2 CỘT NÀY ĐỂ GHÉP LẠI TẠO TÊN FILE) để tách file.

Ví dụ: Zone: A, Alley: 01-------> ghép lại tạo tên file là A01

những file mới tạo ra lưu thành vào đường dẫn có sẵn:
Ví dụ: C:\Users\Administrator\Downloads\Documents: những file mới vừa tạo lưu thành 01 folder riêng(sẽ lưu trong đường dẫn này)
Folder A: sẽ chứa những file có tên là A01,A02............
folder B: sẽ chưa những file có tên là: B01,B02.....
Yêu cầu 1: Em muốn tách sheet thành file và lưu với tên dựa vào điều kiện (cột Zone, cột Alley.)
Yêu cầu2: Khi em copy dữ liệu vào dữ liệu cũ sẽ xóa đi.
yêu cầu 3: khi em copy dữ liệu dán vào thì tự động căn chỉnh dòng và cột.
yêu cầu 4: tạo nút Print hoặc xem trước và in tự động các file này.

Em cảm ơn mọi người nhiều!

Hiện tại không ngồi trên máy tính nền không giúp code cho bạn được, gợi ý bạn thế này. Dùng mảng lưu vùng dữ liệu gốc, sâu đó tiếp tục dùng thêm 2 cái mảng nửa, một cái dùng lưu những dòng thỏa mãn điều kiện, một cái lưu những dòng không thỏa mãn. Duyệt mảng gốc và kiểm tra điều kiện, nếu thỏa mãn điều kiện thì thêm vào mảng thứ nhất, nếu không thỏa mãn thì lưu vào mảng thứ hai. Xóa vùng dữ liệu gốc và gán lại mảng thứ hai xuống vùng dữ liệu gốc, tạo workbook và gán mảng thứ nhất xuống sheet của workbook mới này, sâu đó định dạng lại sheet.

huonglien1901 · 21/10/18

giaiphap đã viết:
Hiện tại không ngồi trên máy tính nền không giúp code cho bạn được, gợi ý bạn thế này. Dùng mảng lưu vùng dữ liệu gốc, sâu đó tiếp tục dùng thêm 2 cái mảng nửa, một cái dùng lưu những dòng thỏa mãn điều kiện, một cái lưu những dòng không thỏa mãn. Duyệt mảng gốc và kiểm tra điều kiện, nếu thỏa mãn điều kiện thì thêm vào mảng thứ nhất, nếu không thỏa mãn thì lưu vào mảng thứ hai. Xóa vùng dữ liệu gốc và gán lại mảng thứ hai xuống vùng dữ liệu gốc, tạo workbook và gán mảng thứ nhất xuống sheet của workbook mới này, sâu đó định dạng lại sheet.

Anh có thể hỗ trợ vấn đề này được không? em thấy vấn đề hơi khó đối với em.

Em cảm ơn Anh nhiều!

Hoàng Nhật Phương · 21/10/18

huonglien1901 đã viết:
Chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

em có một file xuất từ phần mềm ra,
em muốn dựa vào cột Zone và cột Alley(2 CỘT NÀY ĐỂ GHÉP LẠI TẠO TÊN FILE) để tách file.

Ví dụ: Zone: A, Alley: 01-------> ghép lại tạo tên file là A01

những file mới tạo ra lưu thành vào đường dẫn có sẵn:
Ví dụ: C:\Users\Administrator\Downloads\Documents: những file mới vừa tạo lưu thành 01 folder riêng(sẽ lưu trong đường dẫn này)
Folder A: sẽ chứa những file có tên là A01,A02............
folder B: sẽ chưa những file có tên là: B01,B02.....
Yêu cầu 1: Em muốn tách sheet thành file và lưu với tên dựa vào điều kiện (cột Zone, cột Alley.)
Yêu cầu2: Khi em copy dữ liệu vào dữ liệu cũ sẽ xóa đi.
yêu cầu 3: khi em copy dữ liệu dán vào thì tự động căn chỉnh dòng và cột.
yêu cầu 4: tạo nút Print hoặc xem trước và in tự động các file này.

Em cảm ơn mọi người nhiều!

Xin chào huonglien1901
Bạn tham khảo một phần code bên dưới xem có giúp gì được cho bạn không ạ?
Híc bạn đừng hỏi về code vơi Oanh Thơ (OT) nhé, bởi OT chưa biết gì cả.

Mã:

Option Explicit

Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub tachSheet()
    Dim strPath As String, sFileName As String, MyFoldres As String
    Dim nFoldres As String, xWs As String
    Dim sFilePath As String, sh As Worksheet
    strPath = Application.ThisWorkbook.FullName
'    On Error GoTo End_
    Set sh = ThisWorkbook.Worksheets("sheet1")
     sFileName = Mid$(strPath, InStrRev(strPath, "\") + 1)
      nFoldres = Left$(sFileName, (InStrRev(sFileName, ".") - 1))
    Debug.Print sFilePath & nFoldres
    Application.DisplayAlerts = False
     xWs = sh.Range("A2").Value & sh.Range("B2").Value
            MyFoldres = nFoldres
            MakePath MyFoldres & "\": sh.Copy
        With ActiveWorkbook
            .SaveAs MyFoldres & "\" & xWs & ".xlsx", FileFormat:=xlOpenXMLWorkbook
            .Close False
        End With
End_:
    Set sh = Nothing
    Application.DisplayAlerts = True
    If Err <> 0 Then MsgBox Err.Description
End Sub

huonglien1901 · 21/10/18

Nguyễn Hoàng Oanh Thơ đã viết:

Xin chào huonglien1901
Bạn tham khảo một phần code bên dưới xem có giúp gì được cho bạn không ạ?
Híc bạn đừng hỏi về code vơi Oanh Thơ (OT) nhé, bởi OT chưa biết gì cả.

Mã:

Option Explicit

Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub tachSheet()
    Dim strPath As String, sFileName As String, MyFoldres As String
    Dim nFoldres As String, xWs As String
    Dim sFilePath As String, sh As Worksheet
    strPath = Application.ThisWorkbook.FullName
'    On Error GoTo End_
    Set sh = ThisWorkbook.Worksheets("sheet1")
     sFileName = Mid$(strPath, InStrRev(strPath, "\") + 1)
      nFoldres = Left$(sFileName, (InStrRev(sFileName, ".") - 1))
    Debug.Print sFilePath & nFoldres
    Application.DisplayAlerts = False
     xWs = sh.Range("A2").Value & sh.Range("B2").Value
            MyFoldres = nFoldres
            MakePath MyFoldres & "\": sh.Copy
        With ActiveWorkbook
            .SaveAs MyFoldres & "\" & xWs & ".xlsx", FileFormat:=xlOpenXMLWorkbook
            .Close False
        End With
End_:
    Set sh = Nothing
    Application.DisplayAlerts = True
    If Err <> 0 Then MsgBox Err.Description
End Sub

Em cảm ơn chị nhiều! Trường hợp này nó chưa tạo folder cho file, và dữ liệu ở trong file đã mất định dạng rồi. chị xem lại giúp em vơi.

Hoàng Nhật Phương · 21/10/18

huonglien1901 đã viết:
Em cảm ơn chị nhiều! Trường hợp này nó chưa tạo folder cho file, và dữ liệu ở trong file đã mất định dạng rồi. chị xem lại giúp em vơi.

Dạ, bạn thử lại giúp OT ạ.
Đưa code lên đây thấy sao mà run quá

Mã:

Option Explicit

Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub tachSheet()
    Dim strPath As String, sFileName As String
    Dim nFoldres As String, xWs As String
    Dim sFilePath As String, sh As Worksheet
    strPath = Application.ThisWorkbook.FullName
'    On Error GoTo End_
    Set sh = ThisWorkbook.Worksheets("sheet1")
     sFileName = Mid$(strPath, InStrRev(strPath, "\") + 1)
     sFilePath = Left$(strPath, InStrRev(strPath, "\"))
      nFoldres = sFilePath & Left$(sFileName, (InStrRev(sFileName, ".") - 1))
    Debug.Print nFoldres
    Application.DisplayAlerts = False
     xWs = sh.Range("A2").Value & sh.Range("B2").Value
            MakePath nFoldres & "\": sh.Copy
        With ActiveWorkbook
            .SaveAs nFoldres & "\" & xWs & ".xlsx", FileFormat:=xlOpenXMLWorkbook
            .Close False
        End With
End_:
    Set sh = Nothing
    Application.DisplayAlerts = True
    If Err <> 0 Then MsgBox Err.Description
   
End Sub

huonglien1901 · 21/10/18

Nguyễn Hoàng Oanh Thơ đã viết:

Dạ, bạn thử lại giúp OT ạ.
Đưa code lên đây thấy sao mà run quá

Mã:

Option Explicit

Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub tachSheet()
    Dim strPath As String, sFileName As String
    Dim nFoldres As String, xWs As String
    Dim sFilePath As String, sh As Worksheet
    strPath = Application.ThisWorkbook.FullName
'    On Error GoTo End_
    Set sh = ThisWorkbook.Worksheets("sheet1")
     sFileName = Mid$(strPath, InStrRev(strPath, "\") + 1)
     sFilePath = Left$(strPath, InStrRev(strPath, "\"))
      nFoldres = sFilePath & Left$(sFileName, (InStrRev(sFileName, ".") - 1))
    Debug.Print nFoldres
    Application.DisplayAlerts = False
     xWs = sh.Range("A2").Value & sh.Range("B2").Value
            MakePath nFoldres & "\": sh.Copy
        With ActiveWorkbook
            .SaveAs nFoldres & "\" & xWs & ".xlsx", FileFormat:=xlOpenXMLWorkbook
            .Close False
        End With
End_:
    Set sh = Nothing
    Application.DisplayAlerts = True
    If Err <> 0 Then MsgBox Err.Description
  
End Sub

vẫn chưa được chị ơi, Ý em là ví dụ file tên là A01 thì folder sẽ tạo folder A(trong folder A sẽ chứa file(tên là A01.xlsx)(những file có chữ A đứng đầu sẽ lưu trong folder A này.

Và file tên là B01 cũng tương tự như thế!
trường hợp này code vẫn làm mất định dạng, (định dạng ở đây là màu sắc giữ nguyên như file gốc)
Trường hợp code lỗi nếu mở file đó chạy code sẽ báo lỗi #1004.
Nhờ Chị giúp em!

Em cảm ơn chị nhiều!

Hoàng Nhật Phương · 21/10/18

huonglien1901 đã viết:
vẫn chưa được chị ơi, Ý em là ví dụ file tên là A01 thì folder sẽ tạo folder A(trong folder A sẽ chứa file(tên là A01.xlsx)(những file có chữ A đứng đầu sẽ lưu trong folder A này.

Và file tên là B01 cũng tương tự như thế!
..

Xin chào huonglien1901
Bạn thử sửa lại dòng:
nFoldres = sFilePath & Left$(sFileName, (InStrRev(sFileName, ".") - 1))

thành:
nFoldres = sFilePath & Left$(Left$(sFileName, (InStrRev(sFileName, ".") - 1)), 1)

huonglien1901 đã viết:
...
trường hợp này code vẫn làm mất định dạng, (định dạng ở đây là màu sắc giữ nguyên như file gốc)
...

Vụ này OT bó tay rồi T_T, OT chỉ copy/move sheet gốc sang 1 tập tin mới mới, hoặc copy dữ liệu pase sang 1 tập tin mới thì màu sắc nó cũng bị như vậy rồi.. híc híc

huonglien1901 đã viết:
...
Trường hợp code lỗi nếu mở file đó chạy code sẽ báo lỗi #1004.
...

Trường hợp này có thể do bạn đang mở file có tên trùng với tên tập rin saveAs nên nó mới như vậy.

Cảm ơn bạn, OT cũng đang chờ các bạn khác hỗ trợ để hi vọng học thêm được chút xíu ạ.

huonglien1901 · 21/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào huonglien1901
Bạn thử sửa lại dòng:
nFoldres = sFilePath & Left$(sFileName, (InStrRev(sFileName, ".") - 1))

thành:
nFoldres = sFilePath & Left$(Left$(sFileName, (InStrRev(sFileName, ".") - 1)), 1)

Vụ này OT bó tay rồi T_T, OT chỉ copy/move sheet gốc sang 1 tập tin mới mới, hoặc copy dữ liệu pase sang 1 tập tin mới thì màu sắc nó cũng bị như vậy rồi.. híc híc

Trường hợp này có thể do bạn đang mở file có tên trùng với tên tập rin saveAs nên nó mới như vậy.

Cảm ơn bạn, OT cũng đang chờ các bạn khác hỗ trợ để hi vọng học thêm được chút xíu ạ.

Vẫn không được chị ơi!
nFoldres = sFilePath & Left$(Left$(sFileName, (InStrRev(sFileName, ".") - 1)), 1)
dòng này chỉ lấy tên file đứng đầu rồi, ý em là tên file (cột Zone và cột Alley) ghép lại với nhau, rồi lấy ký tự đầu tiên làm folder đó chị.

Hoàng Nhật Phương · 21/10/18

huonglien1901 đã viết:
Vẫn không được chị ơi!
nFoldres = sFilePath & Left$(Left$(sFileName, (InStrRev(sFileName, ".") - 1)), 1)
dòng này chỉ lấy tên file đứng đầu rồi, ý em là tên file (cột Zone và cột Alley) ghép lại với nhau, rồi lấy ký tự đầu tiên làm folder đó chị.

Dạ, bạn thử lại xem sao ạ:

Mã:

Option Explicit

Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub tachSheet()
    Dim strPath As String, nFoldres As String, xWs As String
    Dim sFilePath As String, sh As Worksheet
    strPath = Application.ThisWorkbook.FullName
'    On Error GoTo End_
    Set sh = ThisWorkbook.Worksheets("sheet1")
     xWs = sh.Range("A2").Value & sh.Range("B2").Value
    sFilePath = Left$(strPath, InStrRev(strPath, "\"))
    nFoldres = sFilePath & Left$(xWs, 1)
    
    Debug.Print nFoldres
    Application.DisplayAlerts = False
    MakePath nFoldres & "\": sh.Copy
    With ActiveWorkbook
        .SaveAs nFoldres & "\" & xWs & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        .Close False
    End With
End_:
    Set sh = Nothing
    Application.DisplayAlerts = True
    If Err <> 0 Then MsgBox Err.Description
    
End Sub

giaiphap · 21/10/18

huonglien1901 đã viết:
Chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

em có một file xuất từ phần mềm ra,
em muốn dựa vào cột Zone và cột Alley(2 CỘT NÀY ĐỂ GHÉP LẠI TẠO TÊN FILE) để tách file.

Ví dụ: Zone: A, Alley: 01-------> ghép lại tạo tên file là A01

những file mới tạo ra lưu thành vào đường dẫn có sẵn:
Ví dụ: C:\Users\Administrator\Downloads\Documents: những file mới vừa tạo lưu thành 01 folder riêng(sẽ lưu trong đường dẫn này)
Folder A: sẽ chứa những file có tên là A01,A02............
folder B: sẽ chưa những file có tên là: B01,B02.....
Yêu cầu 1: Em muốn tách sheet thành file và lưu với tên dựa vào điều kiện (cột Zone, cột Alley.)
Yêu cầu2: Khi em copy dữ liệu vào dữ liệu cũ sẽ xóa đi.
yêu cầu 3: khi em copy dữ liệu dán vào thì tự động căn chỉnh dòng và cột.
yêu cầu 4: tạo nút Print hoặc xem trước và in tự động các file này.

Em cảm ơn mọi người nhiều!

Hình như #2 tôi hiểu sai ý bạn thì phải. Bạn xem thử file đúng yêu cầu của mình chưa nhé. Ý thứ 4 mình chịu rồi, chèn code vào được nhưng lưu lại không được, lưu xong mở lên mất code hết cũng không rõ nguyên nhân.

huonglien1901 · 21/10/18

giaiphap đã viết:
Hình như #2 tôi hiểu sai ý bạn thì phải. Bạn xem thử file đúng yêu cầu của mình chưa nhé. Ý thứ 4 mình chịu rồi, chèn code vào được nhưng lưu lại không được, lưu xong mở lên mất code hết cũng không rõ nguyên nhân.

Em cảm ơn Anh nhiều!
Code Anh sẽ báo lỗi nếu tách lại lần thứ 2(ý em nếu lỡ may bấm nút lần 2 thì nó ghi đè dữ liệu luôn Anh)
1. Trường hợp File có tên AT( Anh có thể gom chung vào Folder A được không Anh?) Cái tên file nào có chung A....thì gom vào 01 Forder luôn Anh.
2. Code của Anh khi Tách file xảy ra tình huống là: định dạng đã thay đổi(em muốn vẫn giữ nguyên định dạng font chữ cả màu sắc luôn)
3. Trường hợp để thay đổi đường dẫn thì làm thế nào vậy Anh?

gttrongvn · 21/10/18

giaiphap đã viết:
Hình như #2 tôi hiểu sai ý bạn thì phải. Bạn xem thử file đúng yêu cầu của mình chưa nhé. Ý thứ 4 mình chịu rồi, chèn code vào được nhưng lưu lại không được, lưu xong mở lên mất code hết cũng không rõ nguyên nhân.

Anh đổi lại đuôi file và chỉnh lại số format thử xem. Em thấy định dạng lưu của anh là đuôi .xlsx thì không thể lưu code được.

Bài đã được tự động gộp: 21/10/18

huonglien1901 đã viết:
Chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

em có một file xuất từ phần mềm ra,
em muốn dựa vào cột Zone và cột Alley(2 CỘT NÀY ĐỂ GHÉP LẠI TẠO TÊN FILE) để tách file.

Ví dụ: Zone: A, Alley: 01-------> ghép lại tạo tên file là A01

những file mới tạo ra lưu thành vào đường dẫn có sẵn:
Ví dụ: C:\Users\Administrator\Downloads\Documents: những file mới vừa tạo lưu thành 01 folder riêng(sẽ lưu trong đường dẫn này)
Folder A: sẽ chứa những file có tên là A01,A02............
folder B: sẽ chưa những file có tên là: B01,B02.....
Yêu cầu 1: Em muốn tách sheet thành file và lưu với tên dựa vào điều kiện (cột Zone, cột Alley.)
Yêu cầu2: Khi em copy dữ liệu vào dữ liệu cũ sẽ xóa đi.
yêu cầu 3: khi em copy dữ liệu dán vào thì tự động căn chỉnh dòng và cột.
yêu cầu 4: tạo nút Print hoặc xem trước và in tự động các file này.

Em cảm ơn mọi người nhiều!

Bạn có thể up file nhiều dữ liệu hơn được không (có thể tạo ra nhiều folder, nhiều file)? Với mình chưa hiểu yêu cầu 2,3,4 của bạn lắm, bạn có thể nói rõ hơn được không?

huonglien1901 · 22/10/18

gttrongvn đã viết:
Anh đổi lại đuôi file và chỉnh lại số format thử xem. Em thấy định dạng lưu của anh là đuôi .xlsx thì không thể lưu code được.

Bài đã được tự động gộp: 21/10/18

Bạn có thể up file nhiều dữ liệu hơn được không (có thể tạo ra nhiều folder, nhiều file)? Với mình chưa hiểu yêu cầu 2,3,4 của bạn lắm, bạn có thể nói rõ hơn được không?

Mình gửi bạn!
mình nói rõ yêu cầu là:
Những file có tên AT.., AG...,AH.... đại loại là Tên của File dài chỉ lấy ký tự đầu làm Folder rồi lưu những file đó trong folder mới tạo này.
Những yêu cầu 2,3 có code @giaiphap đáp ứng rồi, nhưng Code xảy ra lỗi là:
Lỗi 01: trường hợp nhấn nút lần 2 (trùng tên) sẽ báo lỗi
Yêu cầu: Nếu trường hợp trùng tên thì hộp thoại thông báo nếu đồng ý là ghi đè dữ liệu, nếu không thì thông báo bạn phải sửa lại dữ liệu.
Lỗi 2: Code mất hết định dạng của File(File đang định dạng Text----khi xuất file (mở file lên thì file đã chuyển về định dạng bình thường rồi.
Yêu cầu: khi xuất file (mở file lên sẽ giữ nguyên định dạng) giống như file ban đầu.
Yêu cầu 4: Nếu được bạn có thể hỗ trợ giúp mình.

Mình cảm ơn Bạn nhiều!

Hoàng Nhật Phương · 22/10/18

Sao toàn zone A file A thế bạn? Không thấy Zone B, Zone C thế vậy?

giaiphap · 22/10/18

gttrongvn đã viết:
Anh đổi lại đuôi file và chỉnh lại số format thử xem. Em thấy định dạng lưu của anh là đuôi .xlsx thì không thể lưu code được.

Dĩ nhiên khi viết code thì tôi cũng biết lưu dưới dạng xlsm mới lưu được code chứ. Khi khi chèn code vào sheet mà không đóng file vẫn thấy bình thường, nhưng nếu dùng code đóng lại thì mất hết code. bạn xem thử và chỉnh sửa cho phù hợp xem.

huonglien1901 đã viết:
Mình gửi bạn!
mình nói rõ yêu cầu là:
Những file có tên AT.., AG...,AH.... đại loại là Tên của File dài chỉ lấy ký tự đầu làm Folder rồi lưu những file đó trong folder mới tạo này.
Những yêu cầu 2,3 có code @giaiphap đáp ứng rồi, nhưng Code xảy ra lỗi là:
Lỗi 01: trường hợp nhấn nút lần 2 (trùng tên) sẽ báo lỗi
Yêu cầu: Nếu trường hợp trùng tên thì hộp thoại thông báo nếu đồng ý là ghi đè dữ liệu, nếu không thì thông báo bạn phải sửa lại dữ liệu.
Lỗi 2: Code mất hết định dạng của File(File đang định dạng Text----khi xuất file (mở file lên thì file đã chuyển về định dạng bình thường rồi.
Yêu cầu: khi xuất file (mở file lên sẽ giữ nguyên định dạng) giống như file ban đầu.
Yêu cầu 4: Nếu được bạn có thể hỗ trợ giúp mình.

Bạn có yêu cầu sau khi copy thì dữ liệu cũ sẽ xóa.

huonglien1901 đã viết:
Yêu cầu2: Khi em copy dữ liệu vào dữ liệu cũ sẽ xóa đi.

Vậy lỡ click lần 2 thì có miến dữ liệu nào trong sheet đâu, báo lỗi là đúng rồi.
Không biết sao nửa, mình chỉ copy sheet hiện tại ra file mới đáng lẻ ra định dạng vẫn giữ nguyên chứ sao lại mất, áp dụng cho file của bạn thì lại mất định dạng, còn dùng file bạn định dạng lại và chạy code thì vẫn đảm bảo yêu cầu, bạn xem thử file này.

Hoàng Nhật Phương · 22/10/18

huonglien1901 đã viết:
Mình gửi bạn!
mình nói rõ yêu cầu là:
Những file có tên AT.., AG...,AH.... đại loại là Tên của File dài chỉ lấy ký tự đầu làm Folder rồi lưu những file đó trong folder mới tạo này.
Những yêu cầu 2,3 có code @giaiphap đáp ứng rồi, nhưng Code xảy ra lỗi là:
Lỗi 01: trường hợp nhấn nút lần 2 (trùng tên) sẽ báo lỗi
Yêu cầu: Nếu trường hợp trùng tên thì hộp thoại thông báo nếu đồng ý là ghi đè dữ liệu, nếu không thì thông báo bạn phải sửa lại dữ liệu.
Lỗi 2: Code mất hết định dạng của File(File đang định dạng Text----khi xuất file (mở file lên thì file đã chuyển về định dạng bình thường rồi.
Yêu cầu: khi xuất file (mở file lên sẽ giữ nguyên định dạng) giống như file ban đầu.
Yêu cầu 4: Nếu được bạn có thể hỗ trợ giúp mình.

Mình cảm ơn Bạn nhiều!

Bạn thử làm theo các bước sau xem có ổn mục 1 khhông ạ:
1.Để tất cả các file ("AT09.xls" "A01.xls" "A02.xls" "A03.xls" "A04.xls" "A05.xls") vào cùng 1 thư mục.
2.Mở tập tin: "Chon file.xlsm"
3.Kích "Button 1" rồi lựa chọn các file ("AT09.xls" "A01.xls" "A02.xls" "A03.xls" "A04.xls" "A05.xls") cần xử lý.

Code trong tập tin:

Mã:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
Sub Test_()
    Dim myFileName As Variant, myFileNames As Variant, wb As Workbook, ret As Long, sh As Worksheet, nFoldres As String, sPath As String
    myFileNames = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*", Title:="Chon cac file can xu ly", MultiSelect:=True)
    If Not IsArray(myFileNames) Then Exit Sub
    Application.DisplayAlerts = False
    For Each myFileName In myFileNames
        Set wb = Workbooks.Open(myFileName, False, False)
        Set sh = wb.Worksheets("Sheet1")
        sPath = wb.Path & "\": nFoldres = Left$(sh.Range("A2").Value, 1)
        MakePath sPath & nFoldres & "\": sh.Copy
        ActiveWorkbook.SaveAs sPath & nFoldres & "\" & wb.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook: ActiveWorkbook.Close False
        wb.Close False
    Next myFileName
    Application.DisplayAlerts = False
End Sub

gttrongvn · 22/10/18

giaiphap đã viết:
Dĩ nhiên khi viết code thì tôi cũng biết lưu dưới dạng xlsm mới lưu được code chứ. Khi khi chèn code vào sheet mà không đóng file vẫn thấy bình thường, nhưng nếu dùng code đóng lại thì mất hết code. bạn xem thử và chỉnh sửa cho phù hợp xem.

Do anh copy sheet nên em cho toàn bộ code của anh vào sheet1 và move ra nên nó chạy được. Còn trường hợp để trong module em nghĩ phải chỉnh sửa lại code theo hướng khác.

huonglien1901 · 22/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Bạn thử làm theo các bước sau xem có ổn mục 1 khhông ạ:
1.Để tất cả các file ("AT09.xls" "A01.xls" "A02.xls" "A03.xls" "A04.xls" "A05.xls") vào cùng 1 thư mục.
2.Mở tập tin: "Chon file.xlsm"
3.Kích "Button 1" rồi lựa chọn các file ("AT09.xls" "A01.xls" "A02.xls" "A03.xls" "A04.xls" "A05.xls") cần xử lý.

Code trong tập tin:

Mã:

Option Explicit Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long Sub Test_() Dim myFileName As Variant, myFileNames As Variant, wb As Workbook, ret As Long, sh As Worksheet, nFoldres As String, sPath As String myFileNames = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*", Title:="Chon cac file can xu ly", MultiSelect:=True) If Not IsArray(myFileNames) Then Exit Sub Application.DisplayAlerts = False For Each myFileName In myFileNames Set wb = Workbooks.Open(myFileName, False, False) Set sh = wb.Worksheets("Sheet1") sPath = wb.Path & "\": nFoldres = Left$(sh.Range("A2").Value, 1) MakePath sPath & nFoldres & "\": sh.Copy ActiveWorkbook.SaveAs sPath & nFoldres & "\" & wb.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook: ActiveWorkbook.Close False wb.Close False Next myFileName Application.DisplayAlerts = False End Sub

Ý em không phải vậy? Tại vì code Anh @giaiphap đối với cột zone AT, cột Alley 09. Khi ghép lại thì mới tạo thành những file AT09 , những file này phải nằm chung trong folder A luôn. Mà code Anh lại tách ra riêng tạo riêng một Folder. Ý em tên file bắt đầu bằng AT.A*. Thì lấy ký tự đầu tiên làm folder gom chung vào 01 đó chị.

Bài đã được tự động gộp: 22/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Sao toàn zone A file A thế bạn? Không thấy Zone B, Zone C thế vậy?

Cái này em ví dụ thôi, đây là phân vùng kiểm kê cửa hàng đó chị.

Bài đã được tự động gộp: 22/10/18

giaiphap đã viết:
Dĩ nhiên khi viết code thì tôi cũng biết lưu dưới dạng xlsm mới lưu được code chứ. Khi khi chèn code vào sheet mà không đóng file vẫn thấy bình thường, nhưng nếu dùng code đóng lại thì mất hết code. bạn xem thử và chỉnh sửa cho phù hợp xem.

Bạn có yêu cầu sau khi copy thì dữ liệu cũ sẽ xóa.

Vậy lỡ click lần 2 thì có miến dữ liệu nào trong sheet đâu, báo lỗi là đúng rồi.
Không biết sao nửa, mình chỉ copy sheet hiện tại ra file mới đáng lẻ ra định dạng vẫn giữ nguyên chứ sao lại mất, áp dụng cho file của bạn thì lại mất định dạng, còn dùng file bạn định dạng lại và chạy code thì vẫn đảm bảo yêu cầu, bạn xem thử file này.

Ý em là: lỡ copy vào thêm lần nữa thì nó sẽ báo trùng đó Anh.
Nếu đồng ý thì ghi đè dữ liệu
Không thì thông báo bạn phải sửa dữ liệu lại.
Em làm phiền anh một tí nữa.
Khi em nhấn vào mặt cười thì xoá dữ liệu và các dòng đi. Chỉ trừ phần tiêu đề file thôi.

ndu96081631 · 22/10/18

Bạn nói:

huonglien1901 đã viết:
em có một file xuất từ phần mềm ra

vậy file đó là file nào? Là file AT09.xls đó à?

huonglien1901 · 22/10/18

ndu96081631 đã viết:
Bạn nói:

vậy file đó là file nào? Là file AT09.xls đó à?

Dạ file đó chưa có tên đó thầy: là workbook 1. workbook 2........, trong workbook sẽ chứa những cột Zone và cột Alley., hai cột này ghép lại sẽ đặt tên file đó Thầy!
Nhờ Thầy hỗ trợ giúp em...

Bài đã được tự động gộp: 22/10/18

giaiphap đã viết:
Dĩ nhiên khi viết code thì tôi cũng biết lưu dưới dạng xlsm mới lưu được code chứ. Khi khi chèn code vào sheet mà không đóng file vẫn thấy bình thường, nhưng nếu dùng code đóng lại thì mất hết code. bạn xem thử và chỉnh sửa cho phù hợp xem.

Bạn có yêu cầu sau khi copy thì dữ liệu cũ sẽ xóa.

Vậy lỡ click lần 2 thì có miến dữ liệu nào trong sheet đâu, báo lỗi là đúng rồi.
Không biết sao nửa, mình chỉ copy sheet hiện tại ra file mới đáng lẻ ra định dạng vẫn giữ nguyên chứ sao lại mất, áp dụng cho file của bạn thì lại mất định dạng, còn dùng file bạn định dạng lại và chạy code thì vẫn đảm bảo yêu cầu, bạn xem thử file này.

Em cảm ơn Anh @giaiphap nhiều! Code đúng ý em rồi, nhưng nhờ Anh sửa lỗi giúp em những cái em nêu dưới.
Trường hợp trùng khi nhấn nút No thì không sao, nhưng Nút Yes sẽ báo lỗi, em muốn khi nhấn nút yes thì sẽ ghi đè dữ liệu luôn Anh.
Trong file khi tách sheet ra, em thấy nút print nhưng khi click chuột vào thì nó không chay, ......Cannot run macro...

gttrongvn · 22/10/18

huonglien1901 đã viết:
Dạ file đó chưa có tên đó thầy: là workbook 1. workbook 2........, trong workbook sẽ chứa những cột Zone và cột Alley., hai cột này ghép lại sẽ đặt tên file đó Thầy!
Nhờ Thầy hỗ trợ giúp em...

Thì bạn nên đưa file workbook đó lên chứ, bạn có thể xóa những dữ liệu quan trọng đi, dữ liệu chi tiết thì mọi người hỗ trợ dễ hơn.

huonglien1901 · 22/10/18

gttrongvn đã viết:
Do anh copy sheet nên em cho toàn bộ code của anh vào sheet1 và move ra nên nó chạy được. Còn trường hợp để trong module em nghĩ phải chỉnh sửa lại code theo hướng khác.

Khi nhấn nút Print thì nó báo lỗi. và định dạng đã thay đổi.

gttrongvn · 22/10/18

Bạn thử file này xem, code của anh GiaiPhap, mình chỉnh lại chút.

huonglien1901 · 22/10/18

gttrongvn đã viết:
Bạn thử file này xem, code của anh GiaiPhap, mình chỉnh lại chút.

cảm ơn bạn rất nhiều!
Làm thế nào mà bạn chuyển định dạng khi copy không mất định dạng vậy bạn. bày mình với.
Vậy trường hợp nhiều máy in thì code làm sao vậy bạn?
nhờ bạn một tí, khi nhấn nút mặt cười thì tự động xóa các dòng dữ liệu đi hết(ý là xóa bỏ khung viền và màu nền cả dữ liệu chỉ còn tiêu đề thôi.)
Cho mình hỏi tí, nếu nhiều người dùng chung file này sẽ như thế nào vậy bạn?

gttrongvn · 22/10/18

huonglien1901 đã viết:
cảm ơn bạn rất nhiều!
Làm thế nào mà bạn chuyển định dạng khi copy không mất định dạng vậy bạn. bày mình với.
Vậy trường hợp nhiều máy in thì code làm sao vậy bạn?
nhờ bạn một tí, khi nhấn nút mặt cười thì tự động xóa các dòng dữ liệu đi hết(ý là xóa bỏ khung viền và màu nền cả dữ liệu chỉ còn tiêu đề thôi.)
Cho mình hỏi tí, nếu nhiều người dùng chung file này sẽ như thế nào vậy bạn?

Mình làm gì đâu,từ file gốc, format cột nào cần định dạng text , copy ra cũng là text thôi. Trường hợp nhiều máy in là sao bạn? "Xóa bỏ khung viền và màu nền cả dữ liệu" của file gốc hay file được tạo ra vậy bạn? Nhiều người dùng chung file là dùng chung file gốc hay file được tạo ra? và dùng chung như thế nào?Bạn nói rõ hơn mọi người mới giúp bạn được.

huonglien1901 · 22/10/18

gttrongvn đã viết:
Mình làm gì đâu,từ file gốc, format cột nào cần định dạng text , copy ra cũng là text thôi. Trường hợp nhiều máy in là sao bạn? "Xóa bỏ khung viền và màu nền cả dữ liệu" của file gốc hay file được tạo ra vậy bạn? Nhiều người dùng chung file là dùng chung file gốc hay file được tạo ra? và dùng chung như thế nào?Bạn nói rõ hơn mọi người mới giúp bạn được.

Nhiều máy in ở đây là: ở công ty nhiều máy in biết kết nối với máy in nào
Nhiều người khi dùng chung file có chung cùng mạng lan thì có ảnh hưởng gì không? File gốc đó bạn.
Xoá dữ liệu xoá định dạng xoá dòng, xoá khung viền ở file gốc.
File tách ra vẫn giữ nguyên định dạng như bạn đầu.

ndu96081631 · 22/10/18

huonglien1901 đã viết:
Dạ file đó chưa có tên đó thầy: là workbook 1. workbook 2........, trong workbook sẽ chứa những cột Zone và cột Alley., hai cột này ghép lại sẽ đặt tên file đó Thầy!
.

Vậy sao bạn không đưa mấy cái workbook1, workbook2 đó lên đây cho tổng quát? Đưa 1 file đã "thành phẩm" ai biết làm sao cho đúng

huonglien1901 · 22/10/18

ndu96081631 đã viết:
Vậy sao bạn không đưa mấy cái workbook1, workbook2 đó lên đây cho tổng quát? Đưa 1 file đã "thành phẩm" ai biết làm sao cho đúng

Dạ đây Thầy!
File xuất xuống có dạng như thế này thầy!

ndu96081631 · 22/10/18

huonglien1901 đã viết:
Dạ đây Thầy!
File xuất xuống có dạng như thế này thầy!

Ủa kỳ vậy ta? Phần mềm xuất ra mỗi file là "riêng" mỗi loại luôn vậy đó à? Tưởng là nó "lộn xộn" nhiều loại cần phải tách ra chứ?
Vậy việc của bạn bây giờ là đổi tên file và đưa vào đúng thư mục thôi chứ gì?
(bạn mà không mô tả rõ ràng thì 20 bài nữa vẫn chưa xong)

huonglien1901 · 22/10/18

ndu96081631 đã viết:
Ủa kỳ vậy ta? Phần mềm xuất ra mỗi file là "riêng" mỗi loại luôn vậy đó à? Tưởng là nó "lộn xộn" nhiều loại cần phải tách ra chứ?

ndu96081631 đã viết:

Vậy việc của bạn bây giờ là đổi tên file và đưa vào đúng thư mục thôi chứ gì?

Nhấp chuột vào đây để mở rộng...

dạ đúng rồi Thầy.
(bạn mà không mô tả rõ ràng thì 20 bài nữa vẫn chưa xong)

Dạ đúng rồi thầy! cứ xuất file xuống( cứ phân vùng là A) là 01 workbook chứa phân vùng là A01..01 workbook chứa phân vùng là A02....
Có những phân vùng AT, AG, AB.....đại loại như vậy thì lấy ký tự đầu tiên gom chung vào 01 thư mục.
còn việc nhờ Thầy file này dùng chung cho nhiều người! thì cách làm sao Thầy?

em cảm ơn thầy nhiều!

ndu96081631 · 22/10/18

huonglien1901 đã viết:
Dạ đúng rồi thầy! cứ xuất file xuống( cứ phân vùng là A) là 01 workbook chứa phân vùng là A01..01 workbook chứa phân vùng là A02....
Có những phân vùng AT, AG, AB.....đại loại như vậy thì lấy ký tự đầu tiên gom chung vào 01 thư mục.
còn việc nhờ Thầy file này dùng chung cho nhiều người! thì cách làm sao Thầy?

em cảm ơn thầy nhiều!

Nếu là vậy thì giải pháp là: Tạo addin dùng chung chứ đâu thể mỗi file 1 code
Công việc chỉ là SaveAs cho đúng tên file, đúng thư mục thôi mà, có gì đâu ta?

huonglien1901 · 22/10/18

ndu96081631 đã viết:
Nếu là vậy thì giải pháp là: Tạo addin dùng chung chứ đâu thể mỗi file 1 code
Công việc chỉ là SaveAs cho đúng tên file, đúng thư mục thôi mà, có gì đâu ta?

DẠ đúng rồi Thầy!
Em tạo file AT09 là File chuẩn, khi những file khi xuất xuống em copy dữ liệu vào File AT09 này, em bấm nút đổi tên thì nó sẽ tự động đổi tên)\
tên File dựa vào cột Zone và cột Alley ghép lại.

ndu96081631 · 22/10/18

huonglien1901 đã viết:
DẠ đúng rồi Thầy!
Em tạo file AT09 là File chuẩn, khi những file khi xuất xuống em copy dữ liệu vào File AT09 này, em bấm nút đổi tên thì nó sẽ tự động đổi tên)\
tên File dựa vào cột Zone và cột Alley ghép lại.

Tôi nghĩ từ giờ trở đi là "chúng ta bắt đầu hiểu nhau" rồi đó.
Các bạn khác cứ theo hướng này viết code, thấy cũng dễ mà

huonglien1901 · 22/10/18

ndu96081631 đã viết:
Tôi nghĩ từ giờ trở đi là "chúng ta bắt đầu hiểu nhau" rồi đó.
Các bạn khác cứ theo hướng này viết code, thấy cũng dễ mà

Thầy có thể giúp em vấn đề này được không?

Em cảm ơn Thầy nhiều!

ndu96081631 · 22/10/18

huonglien1901 đã viết:
Thầy có thể giúp em vấn đề này được không?

Bạn đừng nói vậy khiến người khác buồn lòng. Chắc gì tôi đã viết code hay hơn những người đang giúp bạn trong topic này
Cứ từ từ, đâu cũng vào đó thôi

befaint · 22/10/18

Mình cá rằng 5 files ở bài #29 là do người tạo ra, chứ không phải do phần mềm xuất ra.

"File xuất xuống có dạng như thế này".

Thớt này dài lắm đây.

huonglien1901 · 22/10/18

befaint đã viết:
Mình cá rằng 5 files ở bài #29 là do người tạo ra, chứ không phải do phần mềm xuất ra.

"File xuất xuống có dạng như thế này".

Thớt này dài lắm đây.

Không phải đâu Anh? File đó là do phần mềm xuất ra, khi xuất file xuống từng phân vùng, là dạng file chưa được lưu là New workbook 1,.....
Cứ xuất A01 thì phần mềm xuất ra dạng giống như file em đã gửi những bài trên.

Hoàng Nhật Phương · 22/10/18

Dạ Oanh Thơ xin phép liều một chuyến nữa:

Mã:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function
Function isOpen(ByVal strPath As String)
    Dim wBook As Workbook
    On Error Resume Next
    Set wBook = Workbooks(strPath)
            If wBook Is Nothing Then 'Not open
                Application.Workbooks.Open (strPath)
            End If
End Function
Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Sub Test_()
    Dim myFileName As Variant, myFileNames As Variant, wb As Workbook, ret As Long, sh As Worksheet, nFoldres As String, sPath As String, sFile As String
    myFileNames = Application.GetOpenFilename(, , "Select your File")
    If myFileNames = "" Then Exit Sub
    isOpen (GetFilenameFromPath(myFileNames))
    Set wb = Application.Workbooks(GetFilenameFromPath(myFileNames))
    Call GetData(wb.Name)
    sPath = ThisWorkbook.Path & "\"
    Set sh = ThisWorkbook.Worksheets("Sheet2")
    nFoldres = Left$(sh.Range("A2").Value, 1)
    sFile = sh.Range("A2").Value & sh.Range("A2").Offset(, 1).Value
    Application.DisplayAlerts = False
    MakePath sPath & nFoldres & "\": sh.Copy
    ActiveWorkbook.SaveAs sPath & nFoldres & "\" & nFoldres & "." & sFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook: ActiveWorkbook.Close False
    Application.DisplayAlerts = False
    Sheets(1).Select
End Sub

Sub GetData(sourceFileName As String)
    Dim sourceRngData As Worksheet, destRngData As Range, destWB As Workbook, sFolder As String, rngXYZ As Range
    Const sourceShName As String = "Sheet1": Const destShName As String = "Sheet2"
    On Error GoTo End_
    sFolder = ThisWorkbook.Path & "\"
    If bIsBookOpen(sourceFileName) Then
        Set destWB = Workbooks(sourceFileName)
    Else
        Set destWB = Workbooks.Open(sFolder & sourceFileName)
    End If
    Set sourceRngData = destWB.Worksheets(sourceShName)
    Set rngXYZ = sourceRngData.Range("A1", sourceRngData.Range("A100000").End(xlUp)).Resize(, 10)
    Set destRngData = ThisWorkbook.Worksheets(destShName).Range("A1")
    destRngData.Resize(10000, 10).Clear
    rngXYZ.Copy
    destRngData.PasteSpecial xlPasteColumnWidths
    destRngData.PasteSpecial , , False, False
    Application.CutCopyMode = False
    destWB.Close True
End_:
    Set sourceRngData = Nothing
    Set destRngData = Nothing
    Set destWB = Nothing
    Set rngXYZ = Nothing
End Sub

Rất mong nhận được sự giúp đỡ của các bạn

ndu96081631 · 24/10/18

Nguyễn Hoàng Oanh Thơ đã viết:

Dạ Oanh Thơ xin phép liều một chuyến nữa:

Mã:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function
Function isOpen(ByVal strPath As String)
    Dim wBook As Workbook
    On Error Resume Next
    Set wBook = Workbooks(strPath)
            If wBook Is Nothing Then 'Not open
                Application.Workbooks.Open (strPath)
            End If
End Function
Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Sub Test_()
    Dim myFileName As Variant, myFileNames As Variant, wb As Workbook, ret As Long, sh As Worksheet, nFoldres As String, sPath As String, sFile As String
    myFileNames = Application.GetOpenFilename(, , "Select your File")
    If myFileNames = "" Then Exit Sub
    isOpen (GetFilenameFromPath(myFileNames))
    Set wb = Application.Workbooks(GetFilenameFromPath(myFileNames))
    Call GetData(wb.Name)
    sPath = ThisWorkbook.Path & "\"
    Set sh = ThisWorkbook.Worksheets("Sheet2")
    nFoldres = Left$(sh.Range("A2").Value, 1)
    sFile = sh.Range("A2").Value & sh.Range("A2").Offset(, 1).Value
    Application.DisplayAlerts = False
    MakePath sPath & nFoldres & "\": sh.Copy
    ActiveWorkbook.SaveAs sPath & nFoldres & "\" & nFoldres & "." & sFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook: ActiveWorkbook.Close False
    Application.DisplayAlerts = False
    Sheets(1).Select
End Sub

Sub GetData(sourceFileName As String)
    Dim sourceRngData As Worksheet, destRngData As Range, destWB As Workbook, sFolder As String, rngXYZ As Range
    Const sourceShName As String = "Sheet1": Const destShName As String = "Sheet2"
    On Error GoTo End_
    sFolder = ThisWorkbook.Path & "\"
    If bIsBookOpen(sourceFileName) Then
        Set destWB = Workbooks(sourceFileName)
    Else
        Set destWB = Workbooks.Open(sFolder & sourceFileName)
    End If
    Set sourceRngData = destWB.Worksheets(sourceShName)
    Set rngXYZ = sourceRngData.Range("A1", sourceRngData.Range("A100000").End(xlUp)).Resize(, 10)
    Set destRngData = ThisWorkbook.Worksheets(destShName).Range("A1")
    destRngData.Resize(10000, 10).Clear
    rngXYZ.Copy
    destRngData.PasteSpecial xlPasteColumnWidths
    destRngData.PasteSpecial , , False, False
    Application.CutCopyMode = False
    destWB.Close True
End_:
    Set sourceRngData = Nothing
    Set destRngData = Nothing
    Set destWB = Nothing
    Set rngXYZ = Nothing
End Sub

Rất mong nhận được sự giúp đỡ của các bạn

Ủa sao code nhiều vậy ta? Thấy chỉ có mỗi động tác SaveAs file thôi mà

Cá ngừ F1 · 24/10/18

ndu96081631 đã viết:
Ủa sao code nhiều vậy ta? Thấy chỉ có mỗi động tác SaveAs file thôi mà

Cái này mà dùng Function SaveSheet của sư phụ NDU thì chuẩn luôn.

ndu96081631 · 24/10/18

Cá ngừ F1 đã viết:
Cái này mà dùng Function SaveSheet của sư phụ NDU thì chuẩn luôn.

Cũng không biết đâu. Vì tôi không chắc là mình hiểu đúng ý tác giả

huonglien1901 · 24/10/18

Cá ngừ F1 đã viết:
Cái này mà dùng Function SaveSheet của sư phụ NDU thì chuẩn luôn.

Thì em chỉ copy dữ liệu vào rồi save theo phân vùng Thôi Anh.

Hoàng Nhật Phương · 24/10/18

ndu96081631 đã viết:
Ủa sao code nhiều vậy ta? Thấy chỉ có mỗi động tác SaveAs file thôi mà

Xin chào ndu96081631,
Dạ, code nhiều(code thì không phải do OT viết mà lấy chỗ lọ đập vào chỗ chai ạ,tập tin OT lưu lung tung trong máy tính không rõ nguồn gốc code là của ai nên có chỗ nào không phải mong tất cả các bạn thông cảm) là vì huonglien1901 mong muốn code tự tạo thư mục với tên X và trong thư mục X lại có tên tập tin tên Y,
dữ liệu và định dạng giống y sì tập tin A nào đó được xuất ra từ phần mềm. Các thông tin X và Y lại nằm trong tập A nào đó.
Trong khi Oanh Thơ (OT) chưa biết tạo AddIn nên mới tạo 1 tập tin trung gian để thực hiện việc này.
OT đưa code lên đây không hi vọng giúp được gì nhiều cho huonglien1901, phần lớn để mong nhận được sự góp ý của những người có kiến thức chuyên sâu như ndu96081631 chỉ giáo.

Cá ngừ F1 · 24/10/18

Tôi thử đoán ý bạn nhé:
- Tạo điều kiện lọc (chắc phải dùng Advanced Filter) theo 2 cột A, B, kèm theo đó là đường dẫn tương ứng để lưu file
- Lọc theo điều kiện của cột A, B -> Save sheet thành File vào Folder tương ứng.
Tốt nhất cho 1 File chuẩn lên đây, rồi mô tả kết quả mong muốn xem sao.

Bài đã được tự động gộp: 24/10/18

ndu96081631 đã viết:
Cũng không biết đâu. Vì tôi không chắc là mình hiểu đúng ý tác giả

Cứ thử đoán mò xem sao thôi ạ
Có thể tạo 1 bảng điều kiện lọc kèm theo đường dẫn lưu kết quả.
Chạy 1 vòng lặp để lọc và dùng SaveSheet của sư phụ là đẹp.

giaiphap · 24/10/18

Tôi thấy chủ Topic nên xem lại cách diễn đạt của mình, rõ ràng vấn đề này không khó nhưng cái khó ở đây là đã 46 bài viết rồi mà chẳng ai đoán được tác giả muốn cái gì. Anh @ndu96081631 thì đoán là SaveAs, tác giả thì muốn Save phân vùng còn @Cá ngừ F1 thì là Save sheet, tôi thì hiểu Copy Sheet... Nói chung vấn đề sẽ được giải quyết nếu @huonglien1901 giải thích rõ chi tiết, và đưa dữ liệu mẫu toàn là những file có cột A và B giống nhau, vậy khi chạy code thì chắc chắn tên file sẽ bị trùng. Nên đưa dữ liệu mang tính tổng quát nhất.

huonglien1901 · 24/10/18

giaiphap đã viết:
Tôi thấy chủ Topic nên xem lại cách diễn đạt của mình, rõ ràng vấn đề này không khó nhưng cái khó ở đây là đã 46 bài viết rồi mà chẳng ai đoán được tác giả muốn cái gì. Anh @ndu96081631 thì đoán là SaveAs, tác giả thì muốn Save phân vùng còn @Cá ngừ F1 thì là Save sheet, tôi thì hiểu Copy Sheet... Nói chung vấn đề sẽ được giải quyết nếu @huonglien1901 giải thích rõ chi tiết, và đưa dữ liệu mẫu toàn là những file có cột A và B giống nhau, vậy khi chạy code thì chắc chắn tên file sẽ bị trùng. Nên đưa dữ liệu mang tính tổng quát nhất.

Ý em thế này anh à!
1. đầu tiên em tạo file chuẩn để copy dữ liệu vào khi phần mềm xuất xuống.
2. Khi dán dữ liệu vào file này, em muốn copy dữ liệu trong file này lưu với tên(dựa vào cột Zone&cột Alley)
3. Khi bấm nút xuất file thì dữ liệu được copy và tự động tạo phân vùng(A,B,C,D......)
4. khi những file có chung tên A thì được lưu vào Folder A(những tên như AT, AG,AI(lấy ký tự đầu tiên)--->thì được gom vào thư mục A
5. khi xuất file thì tự động xóa dòng chỉ để dòng tiêu đề lại thôi.

Đây là những yêu cầu của em(mà code Anh đã đáp ứng yêu cầu rồi)

giaiphap · 24/10/18

huonglien1901 đã viết:
Ý em thế này anh à!
1. đầu tiên em tạo file chuẩn để copy dữ liệu vào khi phần mềm xuất xuống.
2. Khi dán dữ liệu vào file này, em muốn copy dữ liệu trong file này lưu với tên(dựa vào cột Zone&cột Alley)
3. Khi bấm nút xuất file thì dữ liệu được copy và tự động tạo phân vùng(A,B,C,D......)
4. khi những file có chung tên A thì được lưu vào Folder A(những tên như AT, AG,AI(lấy ký tự đầu tiên)--->thì được gom vào thư mục A
5. khi xuất file thì tự động xóa dòng chỉ để dòng tiêu đề lại thôi.

Đây là những yêu cầu của em(mà code Anh đã đáp ứng yêu cầu rồi)

Nếu vậy thì theo tôi nên viết thế này, dùng một file riêng (File này chứa code, không có dữ liệu), sau đó thiết kế nút nhấn trên file này để chọn những file dữ liệu (Những file xuất ra từ phần mềm) sau đó code sẽ làm việc mở từng file bạn chọn và lưu lại từng file đó với tên theo như bạn mô tả và khi lưu xong sẽ tự đóng file. Vậy thì sẽ bỏ qua công đoạn xóa dữ liệu cũ và copy dữ liệu mới vào file và cho chạy code. Nếu đúng ý bạn thì thực hiện kiểu này được không?

huonglien1901 · 24/10/18

giaiphap đã viết:
Nếu vậy thì theo tôi nên viết thế này, dùng một file riêng (File này chứa code, không có dữ liệu), sau đó thiết kế nút nhấn trên file này để chọn những file dữ liệu (Những file xuất ra từ phần mềm) sau đó code sẽ làm việc mở từng file bạn chọn và lưu lại từng file đó với tên theo như bạn mô tả và khi lưu xong sẽ tự đóng file. Vậy thì sẽ bỏ qua công đoạn xóa dữ liệu cũ và copy dữ liệu mới vào file và cho chạy code. Nếu đúng ý bạn thì thực hiện kiểu này được không?

giaiphap đã viết:
Nếu vậy thì theo tôi nên viết thế này, dùng một file riêng (File này chứa code, không có dữ liệu)

cái này đúng ý em rồi,

giaiphap đã viết:
sau đó thiết kế nút nhấn trên file này để chọn những file dữ liệu

cái này chưa đúng ý Anh à, tại vì file trên phần mềm xuất ra chưa có tên gì cả(chỉ là worrkbook bình thường thôi) nên chưa biết chọn file nào.
Những cái Anh làm những bài đầu đúng ý rồi Anh, nhưng chỉ tại em muốn khi nhấn nút xuất file dữ liệu sẽ xóa đi và dòng cũng xóa đi(chỉ trừ dòng tiêu đề lại thôi) làm những cái này trên file gốc.

Hoàng Nhật Phương · 24/10/18

huonglien1901 đã viết:
cái này đúng ý em rồi,

cái này chưa đúng ý Anh à, tại vì file trên phần mềm xuất ra chưa có tên gì cả(chỉ là worrkbook bình thường thôi) nên chưa biết chọn file nào.
Những cái Anh làm những bài đầu đúng ý rồi Anh, nhưng chỉ tại em muốn khi nhấn nút xuất file dữ liệu sẽ xóa đi và dòng cũng xóa đi(chỉ trừ dòng tiêu đề lại thôi) làm những cái này trên file gốc.

Có phải ý của @huonglien1901 là copy dữ liệu trực tiếp từ phần mềm rồi pase vào trong tập tin excel có chứa code này,sau đó chỉ việc bấm nút trên tập tin này rồi xử lý các công việc xyz..?

huonglien1901 · 24/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Có phải ý của @huonglien1901 là copy dữ liệu trực tiếp từ phần mềm rồi pase vào trong tập tin excel có chứa code này,sau đó chỉ việc bấm nút trên tập tin này rồi xử lý các công việc xyz..?

Dạ đúng rồi chị!

giaiphap · 24/10/18

huonglien1901 đã viết:
Dạ đúng rồi chị!

Vậy thì tạo cái Add-Ins dùng sẽ đã hơn nhiều, không cần phải copy gì cả, phần mềm xuất ra xong chọn cái là xong.

Hoàng Nhật Phương · 24/10/18

giaiphap đã viết:
Vậy thì tạo cái Add-Ins dùng sẽ đã hơn nhiều, không cần phải copy gì cả, phần mềm xuất ra xong chọn cái là xong.

Cái này chắc bạn ấy không sử dụng chức năng export của phần mềm chú ạ, mà chỉ copy dữ liệu trên màn hình của phần mềm rồi pase vào tập tin excel trắng(kiểu như crl+N) sau đó rồi lưu file này với tên(dựa vào cột Zone&cột Alley) và trong thư mục A(hay 1 tên X nào đó có ký tự đầu tiên của dữ liệu nằm trong cột Zone hay nói cách khác cũng là tên chữ cái đầu tiên của tập tin cần lưu) chú ạ.

Như vậy bài 37 bạn @befaint khẳng định các tập tin bạn ấy đưa lên không phải xuất ra từ phần mềm là đúng rồi,@huonglien1901 vẫn khẳng định dữ liệu xuất ra từ phần mềm là vì bạn ấy đang hiểu dữ liệu được lấy từ phần mềm.
Xuất từ phần mềm khác với lấy từ nguồn (hay nói cách khác là copy từ phần mềm rồi pase trực tiếp vào bảng tính excel).
Cháu thấy thường dữ liệu xuất từ phần mềm không có màu mè gì cả.

Quang_Hải · 25/10/18

Góp vui cho đông vui thêm chút

Mã:

Sub Save_File()
Dim Fso As Object, MyFolder As String
Dim Path As String, MyFile As String, CurSh As Worksheet
Set Fso = CreateObject("scripting.FileSystemObject")
Set CurSh = ActiveSheet
Path = "D:\"
If [A2].Value = Empty Then Exit Sub
MyFolder = Path & Left([A2], 1)
MyFile = MyFolder & "\" & [A2] & [B2]
If Not Fso.folderexists(MyFolder) Then Fso.CreateFolder (MyFolder)
CurSh.Copy
ActiveWorkbook.SaveAs MyFile, 18
ActiveWorkbook.Close False
CurSh.[A2].Resize(1000).EntireRow.ClearContents
End Sub

Cá ngừ F1 · 25/10/18

quanghai1969 đã viết:

Góp vui cho đông vui thêm chút

Mã:

Sub Save_File()
Dim Fso As Object, MyFolder As String
Dim Path As String, MyFile As String, CurSh As Worksheet
Set Fso = CreateObject("scripting.FileSystemObject")
Set CurSh = ActiveSheet
Path = "D:\"
If [A2].Value = Empty Then Exit Sub
MyFolder = Path & Left([A2], 1)
MyFile = MyFolder & "\" & [A2] & [B2]
If Not Fso.folderexists(MyFolder) Then Fso.CreateFolder (MyFolder)
CurSh.Copy
ActiveWorkbook.SaveAs MyFile, 18
ActiveWorkbook.Close False
CurSh.[A2].Resize(1000).EntireRow.ClearContents
End Sub

Đọc code a Hải vẫn thấy sướng (mặc dù chỉ hiểu mang máng). hì hì. (Mà máy ko có ổ D chắc tèo)

Quang_Hải · 25/10/18

Cá ngừ F1 đã viết:
Đọc code a Hải vẫn thấy sướng (mặc dù chỉ hiểu mang máng). hì hì. (Mà máy ko có ổ D chắc tèo)

Cái tật của mình là viết code hởi cẩu thả so với những anh em khác trên GPE cho nên chủ thớt thường phải hỏi lại vài lần. Chủ yếu là câu bài cho mau lên sao.. ka ka. Nhưng mà chắc 99% là có ổ D chứ

huonglien1901 · 5/11/18

quanghai1969 đã viết:
Cái tật của mình là viết code hởi cẩu thả so với những anh em khác trên GPE cho nên chủ thớt thường phải hỏi lại vài lần. Chủ yếu là câu bài cho mau lên sao.. ka ka. Nhưng mà chắc 99% là có ổ D chứ

Em cảm ơn Anh!

Code tách sheet thành 01 file mới rồi vào lưu vào đường dẫn có sẵn (1 người xem)

Người dùng đang xem chủ đề này

GPE là ngôi nhà thứ 2 của tôi!!!

File đính kèm

==(^o^)==

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên gắn bó

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên gắn bó

File đính kèm

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên gắn bó

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên gắn bó

==(^o^)==

File đính kèm

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên hoạt động

GPE là ngôi nhà thứ 2 của tôi!!!

File đính kèm

Thành viên gắn bó

==(^o^)==

File đính kèm

Thành viên gắn bó

File đính kèm

Thành viên hoạt động

File đính kèm

GPE là ngôi nhà thứ 2 của tôi!!!

Huyền thoại GPE

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên hoạt động

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên hoạt động

File đính kèm

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên hoạt động

GPE là ngôi nhà thứ 2 của tôi!!!

Huyền thoại GPE

GPE là ngôi nhà thứ 2 của tôi!!!

File đính kèm

Huyền thoại GPE

GPE là ngôi nhà thứ 2 của tôi!!!

Huyền thoại GPE

GPE là ngôi nhà thứ 2 của tôi!!!

Huyền thoại GPE

GPE là ngôi nhà thứ 2 của tôi!!!

Huyền thoại GPE

|||||||||||||

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên gắn bó

File đính kèm

Huyền thoại GPE

( ͡° ͜ʖ ͡°)

Huyền thoại GPE

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên gắn bó

( ͡° ͜ʖ ͡°)

==(^o^)==

GPE là ngôi nhà thứ 2 của tôi!!!

==(^o^)==

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên gắn bó

GPE là ngôi nhà thứ 2 của tôi!!!

==(^o^)==

Thành viên gắn bó

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

GPE là ngôi nhà thứ 2 của tôi!!!

Thời gian đếm ngược.