Gom sheet và tách file

Liên hệ QC
T

thao nguyen01

Thành viên thường trực
Tham gia
8/12/19
Bài viết
214
Được thích
25
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 ạ.
 

File đính kèm

  • BAN HANG.xlsx
    10.1 KB · Đọc: 18
  • cong ty A.xlsx
    10 KB · Đọc: 14
  • DOANH SO.xlsx
    9.4 KB · Đọc: 16
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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 ạ.
Nhấp chuột vào đây để mở rộng...
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ỉ.
 
Lần chỉnh sửa cuối:
Upvote 0
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 ạ.
 
Upvote 0
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 ạ.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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 ạ.
Nhấp chuột vào đây để mở rộng...
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é.
 

File đính kèm

  • TachSheet.rar
    37.9 KB · Đọc: 19
Upvote 0
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é.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
Upvote 0
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 ạ.
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • DOANH SO_TachFile.xlsm
    18.8 KB · Đọc: 13
Upvote 0
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é.
Nhấp chuột vào đây để mở rộng...
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:

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
Nhấp chuột vào đây để mở rộng...
Dạ, em cảm ơn anh nhiều ạ
 

File đính kèm

  • TachFile.xlsm
    18.1 KB · Đọc: 5
  • cong ty A.xlsx
    9.7 KB · Đọc: 9
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

giongbandia
Hàm importrange báo #REF
Trả lời
4
Đọc
3K
TonyVTC
TonyVTC
HuynhThiMinhPhung
nối dữ liệu từ nhiều worksheet
Trả lời
2
Đọc
15
CHAOQUAY
C
C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
6
Đọc
107
caocat
C
T
Hỏi về các tính tổng của một số theo thể thức tam giác pascal
Trả lời
9
Đọc
5K
Xphuonc
Xphuonc
LuuAnh980
Filter lọc có "mm" mà không thấy.
Trả lời
4
Đọc
110
LuuAnh980
LuuAnh980
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom