Xuất Dữ Liệu Từ 1 File Excel Tổng Ra Nhiều File Excel Con

Chia sẻ bởi:hands
★★★★★
Quảng cáo

Chào mọi người.

Mình có bài toán như sau, nhờ mọi người hỗ trợ.
Trong file dữ liệu tổng mình có rất nhiều NCC khác nhau.
Để quản lý và gửi cho từng nhà cung cấp riêng lẻ, thì từ file tổng mình phải xuất dữ liệu ra nhiều file.
Bây giờ mình muốn giải quyết bằng VBA , khi mình click vào nút xuất dữ liệu.
Thì từng cột giá trị liên quan đến NCC nào, sẽ được xuất ra file riêng lẻ theo định dạng có sẵn.
Mình có tạo dữ liệu mẫu như trong file đính kèm.
Nhờ mọi người giúp đỡ nhé.

Dùng thử code này xem sao?

Public Sub GPE()
Dim i%, j%, Arr, Path As String, NewWb, Wb
Dim fso As Object, sFile As String
Set fso = CreateObject("Scripting.FileSystemObject")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Set Wb = ThisWorkbook
    Path = ThisWorkbook.Path
    Arr = Sheet1.Range("A3", Sheet1.[F65000].End(3)).Value

j = UBound(Arr)
        For i = 2 To UBound(Arr, 2)
            sFile = Path & "" & Arr(1, i) & ".xlsx"
            If fso.FileExists(sFile) Then
                Set NewWb = Workbooks.Open(sFile)
                With NewWb
                    Wb.Sheets(1).Range("A3").Resize(j).Copy .Sheets(1).[A3]
                    Wb.Sheets(1).Range("A3").Offset(, i - 1).Resize(j).Copy .Sheets(1).[B3]
                    .Close True
                End With
            End If
        Next i
    j = UBound(Arr, 2)
        For i = 2 To UBound(Arr)
            sFile = Path & "" & Arr(i, 1) & ".xlsx"
            If fso.FileExists(sFile) Then
                Set NewWb = Workbooks.Open(sFile)
                With NewWb
                    Wb.Sheets(1).Range("A3").Resize(, j).Copy .Sheets(1).[A3]
                    Wb.Sheets(1).Range("A4").Offset(i - 2).Resize(, j).Copy .Sheets(1).[A4]
                    .Close True
                End With
            End If
        Next i

Set NewWb = Nothing
    Set fso = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien viec tach du lieu xong"
End Sub

www.giaiphapexcel.com/diendan/threads/xu%C3%A2%CC%81t-d%C6%B0%CC%83-li%C3%AA%CC%A3u-t%C6%B0%CC%80-1-file-excel-t%C3%B4%CC%89ng-ra-nhi%C3%AA%CC%80u-file-excel-con.150300/

Khóa học Power PI – Ứng dung trong Nhân sự
Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học
★★★★★ 5 ★ 1 👤 3 ▥ 0
Quảng cáo

Bạn nên đọc

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo

Cũ vẫn chất

Xem thêm