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

[huonglien1901]

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!

 

[huonglien1901]

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

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]

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]

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]

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

 

[huonglien1901]

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]

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]

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]

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]

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]

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]

Ủ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ì?

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]

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]

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]

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]

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]

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]

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]

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]

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

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]

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

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à