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)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
huonglien1901

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia
17/4/16
Bài viết
2,702
Được thích
2,434
Giới tính
Nam
Nghề nghiệp
Nhân viên kỹ thuật in ấn
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!
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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!
Nhấp chuột vào đây để mở rộng...
Hiện tại không ngồi trên máy tính nền không giúp code cho bạn được, gợi ý bạn thế này. Dùng mảng lưu vùng dữ liệu gốc, sâu đó tiếp tục dùng thêm 2 cái mảng nửa, một cái dùng lưu những dòng thỏa mãn điều kiện, một cái lưu những dòng không thỏa mãn. Duyệt mảng gốc và kiểm tra điều kiện, nếu thỏa mãn điều kiện thì thêm vào mảng thứ nhất, nếu không thỏa mãn thì lưu vào mảng thứ hai. Xóa vùng dữ liệu gốc và gán lại mảng thứ hai xuống vùng dữ liệu gốc, tạo workbook và gán mảng thứ nhất xuống sheet của workbook mới này, sâu đó định dạng lại sheet.
 
Upvote 0
giaiphap đã viết:
Hiện tại không ngồi trên máy tính nền không giúp code cho bạn được, gợi ý bạn thế này. Dùng mảng lưu vùng dữ liệu gốc, sâu đó tiếp tục dùng thêm 2 cái mảng nửa, một cái dùng lưu những dòng thỏa mãn điều kiện, một cái lưu những dòng không thỏa mãn. Duyệt mảng gốc và kiểm tra điều kiện, nếu thỏa mãn điều kiện thì thêm vào mảng thứ nhất, nếu không thỏa mãn thì lưu vào mảng thứ hai. Xóa vùng dữ liệu gốc và gán lại mảng thứ hai xuống vùng dữ liệu gốc, tạo workbook và gán mảng thứ nhất xuống sheet của workbook mới này, sâu đó định dạng lại sheet.
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...

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ả. :D

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
 
Upvote 0
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ả. :D

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
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...

Dạ, bạn thử lại giúp OT ạ.
Đưa code lên đây thấy sao mà run quá :D
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
 

File đính kèm

Upvote 0
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á :D
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
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
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ế!
..
Nhấp chuột vào đây để mở rộng...

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)
...
Nhấp chuột vào đây để mở rộng...
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.
...
Nhấp chuột vào đây để mở rộng...

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 ạ.
 
Upvote 0
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 ạ.
Nhấp chuột vào đây để mở rộng...
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ị.
 
Upvote 0
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ị.
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...
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.
 

File đính kèm

Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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?
 
Lần chỉnh sửa cuối:
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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:

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!
Nhấp chuột vào đây để mở rộng...
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?
 
Upvote 0
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:


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?
Nhấp chuột vào đây để mở rộ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!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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.
Nhấp chuột vào đây để mở rộng...
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.
Nhấp chuột vào đây để mở rộng...
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.
 

File đính kèm

Upvote 0
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!
Nhấp chuột vào đây để mở rộng...

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
 

File đính kèm

Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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.
 

File đính kèm

Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Ý 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:

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?
Nhấp chuột vào đây để mở rộng...
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:

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.
Nhấp chuột vào đây để mở rộng...
Ý 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.
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

T
In lặp lại nhiều dòng ở cuối các trang (1 người xem)
Trả lời
7
Đọc
294
Hoàng Tuấn 868
H
T
Lỗi Khi Mở File Excel (2 người xem)
Trả lời
3
Đọc
49
Hoàng Tuấn 868
H
GPE-Trợ Lý
ĐĂNG KÍ THAM DỰ SINH NHẬT GPE TẠI HN - SỰ KIỆN TALKSHOW ĐẶC BIỆT (1 người xem)
    • Thích
2
Trả lời
23
Đọc
1K
PhanTuHuong
PhanTuHuong
H
Em chào anh chị ạ.Em cần xếp lịch nghỉ randum cho 1 số nhóm làm việc trong 1 công ty. (1 người xem)
Trả lời
4
Đọc
99
Duy Tùng 9x
Duy Tùng 9x
K
Tạo mã thiết bị
Trả lời
9
Đọc
175
Duy Tùng 9x
Duy Tùng 9x
1
Em hỏi chút về hàm điều kiện với liệt kê
Trả lời
2
Đọc
114
123456it
1
M
File excel ứng dụng trong nhập xuất kho, thu chi, bán hàng và công nợ
    • Thích
    • Yêu thích
    • Cảm ơn
7 8 9
Trả lời
165
Đọc
31K
quick87
quick87
chickenexcel
xin hướng dẫn code chọn hình ảnh trong file (2 người xem)
Trả lời
2
Đọc
73
chickenexcel
chickenexcel
tramcannt
data validation
Trả lời
2
Đọc
85
ptm0412
ptm0412
giaiphap
Add-Ins cho Excel 2007 -2016 32bit và 64bit (1 người xem)
    • Thích
    • Yêu thích
    • Ngạc nhiên
24 25 26
Trả lời
514
Đọc
204K
hoangtuan.net
hoangtuan.net
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024) (2 người xem)
    • Thích
2 3
Trả lời
56
Đọc
7K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
  • Dán lên cao
Sử dụng AI trong Excel với Add-in A-Tools AI v10 (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
6
Đọc
794
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
Lỗi syntax error
Trả lời
2
Đọc
102
ptm0412
ptm0412
H
Xin các bác giúp đỡ cách đổi thời gian thành số thập phân
Trả lời
8
Đọc
150
huyphanthieu
H
T
Cách cộng tổng chính xác nhất
Trả lời
4
Đọc
110
ngocbaovu
ngocbaovu
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
17 18 19
Trả lời
361
Đọc
40K
NGUYEN THOA 123
NGUYEN THOA 123
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
tungnguyen_kt
tungnguyen_kt
Maithy46
Giúp mình về việc lập bảng theo dõi chi tiết, báo cáo sản lượng công đoạn trong ngành may mặc ạ
Trả lời
4
Đọc
520
Maithy46
Maithy46
MrAnt
Dùng excel add-in lấy báo cáo từ SQL
Trả lời
5
Đọc
500
Nhattanktnn
Nhattanktnn
Bùi Thúy Thúy
Tắt thông báo "Sign in" khi mở file excel
Trả lời
1
Đọc
112
vanle33
vanle33
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom