Gom sheet và tách file

thao nguyen01 · 7/6/21

Kính gửi anh/chị trên diễn đàn,

Em gặp chút vướng mắc anh chị xem giúp em với ạ. Em có một file bán hàng trong đó em có hơn 40 sheet, tương tự em có file doanh số cũng có số lượng sheet giống file bán hàng. Trong file em ví dụ khoảng hai công ty ạ. Em muốn lấy sheet công ty A trong file bán hàng và sheet công ty B trong file doanh số, sau đó tách ra thành một file tên công ty A bao gồm hai sheet. Tương tự như vậy, em muốn tách ra các file còn lại ạ. Vì làm thủ công em copy từng sheet của từng file vô từng công ty mất khá nhiều thời gian. Anh/chị xem giúp em với ạ. Em có file kết quả mong muốn tên là Công Ty A ạ.

Em cảm ơn anh/chị nhiều ạ.

Hoàng Tuấn 868 · 7/6/21

thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,

Em gặp chút vướng mắc anh chị xem giúp em với ạ. Em có một file bán hàng trong đó em có hơn 40 sheet, tương tự em có file doanh số cũng có số lượng sheet giống file bán hàng. Trong file em ví dụ khoảng hai công ty ạ. Em muốn lấy sheet công ty A trong file bán hàng và sheet công ty B trong file doanh số, sau đó tách ra thành một file tên công ty A bao gồm hai sheet. Tương tự như vậy, em muốn tách ra các file còn lại ạ. Vì làm thủ công em copy từng sheet của từng file vô từng công ty mất khá nhiều thời gian. Anh/chị xem giúp em với ạ. Em có file kết quả mong muốn tên là Công Ty A ạ.

Em cảm ơn anh/chị nhiều ạ.

Mình vừa thử túc tắc làm thủ công mỗi file hết khoảng trên dưới một phút thôi bạn, vậy 40 file cần gì đến VBA nhỉ.

thao nguyen01 · 8/6/21

Hoàng Tuấn 868 đã viết:
Mình vừa thử túc tắc làm thủ công mỗi file hết khoảng trên dưới một phút thôi bạn, vậy 40 file cần gì đến VBA nhỉ.

Dạ. Vì công việc này lặp lại thường xuyên và mình muốn học thêm về VBA nữa ạ.

VetMini · 8/6/21

thao nguyen01 đã viết:
Dạ. Vì công việc này lặp lại thường xuyên và mình muốn học thêm về VBA nữa ạ.

Nếu tôi chỉ mách cho cách làm thì bạn viết code được không?

thao nguyen01 · 8/6/21

Dạ. Em có học và viết code nhiều sheet vô một sheet. Nhưng với dạng này, em không biết cách chỉ định. Em ví dụ chọn công ty A, thì sẽ lấy công ty A trên từng file. Nếu làm cách đó thì mỗi lần em muốn lấy từng công ty phải vô code chỉnh lại. Em nghĩ như vậy mất thời gian giống thủ công ạ. Còn viết cách chỉ định thì em nghĩ em chưa đủ khả năng làm ạ. Vì vậy em muốn gửi bài này lên diễn đàn để anh chị hỗ trợ giúp em và em cũng muốn học thêm ạ.

Nhattanktnn · 8/6/21

thao nguyen01 đã viết:
Dạ. Em có học và viết code nhiều sheet vô một sheet. Nhưng với dạng này, em không biết cách chỉ định. Em ví dụ chọn công ty A, thì sẽ lấy công ty A trên từng file. Nếu làm cách đó thì mỗi lần em muốn lấy từng công ty phải vô code chỉnh lại. Em nghĩ như vậy mất thời gian giống thủ công ạ. Còn viết cách chỉ định thì em nghĩ em chưa đủ khả năng làm ạ. Vì vậy em muốn gửi bài này lên diễn đàn để anh chị hỗ trợ giúp em và em cũng muốn học thêm ạ.

Nếu bạn đã biết viết như vậy thì thử cố gắng tự hình dung cách làm bằng tay, rồi record macro kết hợp tìm hiểu trên mạng. Khó chỗ nào hỏi chỗ đó thì hay hơn

thao nguyen01 · 8/6/21

Nhattanktnn đã viết:
Nếu bạn đã biết viết như vậy thì thử cố gắng tự hình dung cách làm bằng tay, rồi record macro kết hợp tìm hiểu trên mạng. Khó chỗ nào hỏi chỗ đó thì hay hơn

Dạ. Em cảm ơn ạ

Hai Lúa Miền Tây · 8/6/21

thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,

Em gặp chút vướng mắc anh chị xem giúp em với ạ. Em có một file bán hàng trong đó em có hơn 40 sheet, tương tự em có file doanh số cũng có số lượng sheet giống file bán hàng. Trong file em ví dụ khoảng hai công ty ạ. Em muốn lấy sheet công ty A trong file bán hàng và sheet công ty B trong file doanh số, sau đó tách ra thành một file tên công ty A bao gồm hai sheet. Tương tự như vậy, em muốn tách ra các file còn lại ạ. Vì làm thủ công em copy từng sheet của từng file vô từng công ty mất khá nhiều thời gian. Anh/chị xem giúp em với ạ. Em có file kết quả mong muốn tên là Công Ty A ạ.

Em cảm ơn anh/chị nhiều ạ.

Tạo file mẫu là file Temp.xlsx nằm chung với thư mục 2 files [Ban Hang.xlsx] và [Doanh So.xlsx] (*), tạo 1 folder có tên KetQua để chứa các files kết quả. Từ 1 file có đường dẫn chung với (*) chứa code sau, trong file này bạn lấy danh sách tên sheet từ file (*)

Mã:

Sub TachSheet_HLMT()
    Dim arrCty  As Variant, arrDanhMuc As Variant
    Dim i As Integer, ir As Integer
    Dim shtName As String, strPath As String
    Dim fso As Object
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    arrCty = Sheet1.Range("A2:A3").Value ' Luu y chinh vung du lieu hop ly
    arrDanhMuc = Array("BAN HANG", "DOANH SO")
    For ir = LBound(arrCty) To UBound(arrCty)
        shtName = arrCty(ir, 1)
        Call fso.CopyFile(strPath & "\Temp.xlsx", strPath & "\KetQua\" & shtName & ".xlsx", True)
        For i = LBound(arrDanhMuc) To UBound(arrDanhMuc)
            With CreateObject("ADODB.Connection")
                .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & "\KetQua\" & shtName & ".xlsx;Extended Properties=Excel 12.0"
                .Execute ("INSERT INTO [" & arrDanhMuc(i) & "$] SELECT * FROM [EXCEL 12.0;Database=" & strPath & "\" & arrDanhMuc(i) & ".xlsx].[" & shtName & "$]")
             End With
        Next
    Next
End Sub

Bạn tải file sau, giải nén rồi vào đường dẫn vừa giải nén, mở file TachFile rồi nhấn nút chạy thử nhé.

Hai Lúa Miền Tây · 8/6/21

Hai Lúa Miền Tây đã viết:
Tạo file mẫu là file Temp.xlsx nằm chung với thư mục 2 files [Ban Hang.xlsx] và [Doanh So.xlsx] (*), tạo 1 folder có tên KetQua để chứa các files kết quả. Từ 1 file có đường dẫn chung với (*) chứa code sau, trong file này bạn lấy danh sách tên sheet từ file (*)

Mã:

Sub TachSheet_HLMT() Dim arrCty As Variant, arrDanhMuc As Variant Dim i As Integer, ir As Integer Dim shtName As String, strPath As String Dim fso As Object Set fso = VBA.CreateObject("Scripting.FileSystemObject") strPath = ThisWorkbook.Path arrCty = Sheet1.Range("A2:A3").Value ' Luu y chinh vung du lieu hop ly arrDanhMuc = Array("BAN HANG", "DOANH SO") For ir = LBound(arrCty) To UBound(arrCty) shtName = arrCty(ir, 1) Call fso.CopyFile(strPath & "\Temp.xlsx", strPath & "\KetQua\" & shtName & ".xlsx", True) For i = LBound(arrDanhMuc) To UBound(arrDanhMuc) With CreateObject("ADODB.Connection") .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & "\KetQua\" & shtName & ".xlsx;Extended Properties=Excel 12.0" .Execute ("INSERT INTO [" & arrDanhMuc(i) & "$] SELECT * FROM [EXCEL 12.0;Database=" & strPath & "\" & arrDanhMuc(i) & ".xlsx].[" & shtName & "$]") End With Next Next End Sub

Bạn tải file sau, giải nén rồi vào đường dẫn vừa giải nén, mở file TachFile rồi nhấn nút chạy thử nhé.

Chỉnh code trên lại chút, @thao nguyen01 thử lại code sau nhé:

Mã:

Sub TachSheet_HLMT()
    Dim arrCty  As Variant, arrDanhMuc As Variant
    Dim i As Integer, ir As Integer
    Dim shtName As String, strPath As String
    Dim fso As Object
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    arrCty = Sheet1.Range("A2:A3").Value
    arrDanhMuc = Array("BAN HANG", "DOANH SO")
    For ir = LBound(arrCty) To UBound(arrCty)
        shtName = arrCty(ir, 1)
        Call fso.CopyFile(strPath & "\Temp.xlsx", strPath & "\KetQua\" & shtName & ".xlsx", True)
        With CreateObject("ADODB.Connection")
            .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & "\KetQua\" & shtName & ".xlsx;Extended Properties=Excel 12.0"
            For i = LBound(arrDanhMuc) To UBound(arrDanhMuc)
              .Execute ("INSERT INTO [" & arrDanhMuc(i) & "$] SELECT * FROM [EXCEL 12.0;Database=" & strPath & "\" & arrDanhMuc(i) & ".xlsx].[" & shtName & "$]")
            Next
         End With
    Next
End Sub

thao nguyen01 · 8/6/21

Hai Lúa Miền Tây đã viết:

Chỉnh code trên lại chút, @thao nguyen01 thử lại code sau nhé:

Mã:

Sub TachSheet_HLMT()
    Dim arrCty  As Variant, arrDanhMuc As Variant
    Dim i As Integer, ir As Integer
    Dim shtName As String, strPath As String
    Dim fso As Object
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    arrCty = Sheet1.Range("A2:A3").Value
    arrDanhMuc = Array("BAN HANG", "DOANH SO")
    For ir = LBound(arrCty) To UBound(arrCty)
        shtName = arrCty(ir, 1)
        Call fso.CopyFile(strPath & "\Temp.xlsx", strPath & "\KetQua\" & shtName & ".xlsx", True)
        With CreateObject("ADODB.Connection")
            .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & "\KetQua\" & shtName & ".xlsx;Extended Properties=Excel 12.0"
            For i = LBound(arrDanhMuc) To UBound(arrDanhMuc)
              .Execute ("INSERT INTO [" & arrDanhMuc(i) & "$] SELECT * FROM [EXCEL 12.0;Database=" & strPath & "\" & arrDanhMuc(i) & ".xlsx].[" & shtName & "$]")
            Next
         End With
    Next
End Sub

Dạ. Em cảm ơn Thầy nhiều ạ. Em có làm thử và có vài vấn đề nhỏ Thầy xem giúp em ạ. Khi danh sách liệt kê không lớn hơn 2 công ty thì sẽ báo lỗi đường dẫn do sheet lấy theo mảng ạ? Và em xem trong file kết quả định dạng của số đang định dạng bên trái và khi em kéo cộng lại thử thì góc phải hiện dạng count không phải sum ạ. Nhưng em cộng thử trên excel thì vẫn ra số, không phải định dạng text. Em chưa hiểu bị vấn đề gì ạ. Thầy xem giúp em. Em cảm ơn Thầy ạ.

Phuocam · 9/6/21

thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,

Em gặp chút vướng mắc anh chị xem giúp em với ạ. Em có một file bán hàng trong đó em có hơn 40 sheet, tương tự em có file doanh số cũng có số lượng sheet giống file bán hàng. Trong file em ví dụ khoảng hai công ty ạ. Em muốn lấy sheet công ty A trong file bán hàng và sheet công ty B trong file doanh số, sau đó tách ra thành một file tên công ty A bao gồm hai sheet. Tương tự như vậy, em muốn tách ra các file còn lại ạ. Vì làm thủ công em copy từng sheet của từng file vô từng công ty mất khá nhiều thời gian. Anh/chị xem giúp em với ạ. Em có file kết quả mong muốn tên là Công Ty A ạ.

Em cảm ơn anh/chị nhiều ạ.

Thử chạy code trong file DOANH SO:

Mã:

Public Sub TachFile()
Dim strPath As String, TenCongTy As String
Dim ws As Worksheet
Dim wbDoanhSo As Workbook, wbBanHang As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

strPath = ThisWorkbook.Path & "\"
Set wbDoanhSo = ThisWorkbook
Set wbBanHang = Workbooks.Open(strPath & "BAN HANG.xlsx")
For Each ws In wbDoanhSo.Worksheets
    TenCongTy = ws.Name
    ws.Copy
    With ActiveWorkbook
        .ActiveSheet.Name = "Doanh so"
        .Sheets.Add After:=Worksheets("Doanh so")
        .ActiveSheet.Name = "Ban hang"
        wbBanHang.Sheets(TenCongTy).Cells.Copy .Sheets("Ban hang").Range("A1")
        .SaveAs Filename:=strPath & TenCongTy & ".xlsx"
        .Close False
    End With
Next ws
wbBanHang.Close False

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Hai Lúa Miền Tây · 9/6/21

thao nguyen01 đã viết:
Khi danh sách liệt kê không lớn hơn 2 công ty thì sẽ báo lỗi đường dẫn do sheet lấy theo mảng ạ?

Bạn gửi code của bạn lên tôi xem thử nhé.

thao nguyen01 · 9/6/21

Hai Lúa Miền Tây đã viết:
Bạn gửi code của bạn lên tôi xem thử nhé.

Dạ. Em lấy code bài #9 của Thầy ạ. Em chạy sheet TachFile, em có đính kèm kết quả ví dụ công ty A về vấn đề định dạng bài #10 ạ. Thầy xem giúp em ạ. Em cảm ơn Thầy.

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

phuocam đã viết:

Thử chạy code trong file DOANH SO:

Mã:

Public Sub TachFile()
Dim strPath As String, TenCongTy As String
Dim ws As Worksheet
Dim wbDoanhSo As Workbook, wbBanHang As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

strPath = ThisWorkbook.Path & "\"
Set wbDoanhSo = ThisWorkbook
Set wbBanHang = Workbooks.Open(strPath & "BAN HANG.xlsx")
For Each ws In wbDoanhSo.Worksheets
    TenCongTy = ws.Name
    ws.Copy
    With ActiveWorkbook
        .ActiveSheet.Name = "Doanh so"
        .Sheets.Add After:=Worksheets("Doanh so")
        .ActiveSheet.Name = "Ban hang"
        wbBanHang.Sheets(TenCongTy).Cells.Copy .Sheets("Ban hang").Range("A1")
        .SaveAs Filename:=strPath & TenCongTy & ".xlsx"
        .Close False
    End With
Next ws
wbBanHang.Close False

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Dạ, em cảm ơn anh nhiều ạ

Gom sheet và tách file

thao nguyen01

Thành viên thường trực

File đính kèm

Hoàng Tuấn 868

Đăng ký hôm qua

thao nguyen01

Thành viên thường trực

VetMini

Ăn cùng góc phố

thao nguyen01

Thành viên thường trực

Nhattanktnn

Thành viên gắn bó

thao nguyen01

Thành viên thường trực

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

File đính kèm

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

thao nguyen01

Thành viên thường trực

Phuocam

Thành viên mới

File đính kèm

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

thao nguyen01

Thành viên thường trực

File đính kèm

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

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