lấy dữ liệu từ File Khác và save New File

[ngoctuyen1995]

Thân chào cả nhà GPEX!
Hiện tại em có 02 File:
1. File Data (bao gồm hơn 90 sheet - em chỉ demo 04 sheet thôi ạ)
2. File Danh sách (sheet CTKM và Sheet Run)
Em muốn tạo một nút button từ File Danh sách tại sheet Run để khi Click vào sẽ xuất hiện hộp thoại để select tới File Data và làm các bước:
1. Dựa vào Sheet CTKM (cột E - Barcode) Map với cột Barcode (cột D) ở File Data để lấy thông tin Sap code (cột C) từ Sheet CTKM qua file Data (Cột E) Sap Code theo các Sheet (trừ Sheet All Store).
2. Dựa vào Sheet CTKM (cột E - Barcode) Map với cột Barcode (cột D) ở File Data để lấy thông tin Giá bán ra (+VAT) từ Sheet CTKM qua file Data (cột G)theo các Sheet (trừ Sheet All Store).
3. Save New File kết quả (em có đính kèm file Demo kết quả cho dễ hiểu ý em ạ)

Vì số lượng sheet quá nhiều em làm bằng tay khá mất thời gian và công việc cứ 3 ngày lập lại 1 lần nên em khá khó khăn.
Mong cả nhà giúp đỡ, em chân thành cảm ơn ạ..

 

[Maika8008]

Y như Vlookup hoặc Index, Match qua thôi phải không nhỉ?

 

[ngoctuyen1995]

Y như Vlookup hoặc Index, Match qua thôi phải không nhỉ?

đúng rồi ạ, hiện tại em đang làm bằng tay vlookup cho hơn 90 sheet đó ạ @@!

 

[HUONGHCKT]

Thân chào cả nhà GPEX!
Hiện tại em có 02 File:
1. File Data (bao gồm hơn 90 sheet - em chỉ demo 04 sheet thôi ạ)
2. File Danh sách (sheet CTKM và Sheet Run)
Em muốn tạo một nút button từ File Danh sách tại sheet Run để khi Click vào sẽ xuất hiện hộp thoại để select tới File Data và làm các bước:
1. Dựa vào Sheet CTKM (cột E - Barcode) Map với cột Barcode (cột D) ở File Data để lấy thông tin Sap code (cột C) từ Sheet CTKM qua file Data (Cột E) Sap Code theo các Sheet (trừ Sheet All Store).
2. Dựa vào Sheet CTKM (cột E - Barcode) Map với cột Barcode (cột D) ở File Data để lấy thông tin Giá bán ra (+VAT) từ Sheet CTKM qua file Data (cột G)theo các Sheet (trừ Sheet All Store).
3. Save New File kết quả (em có đính kèm file Demo kết quả cho dễ hiểu ý em ạ)

Vì số lượng sheet quá nhiều em làm bằng tay khá mất thời gian và công việc cứ 3 ngày lập lại 1 lần nên em khá khó khăn.
Mong cả nhà giúp đỡ, em chân thành cảm ơn ạ..

Theo tôi bạn để File Data.xlsx trong cùng folder với file Danh sach.xlsm để khi chạy code bạn không cần phải chọn File data.xlsx nữa.

Trong khi chờ các giải pháp khác hãy tham khảo code sau:

Option Explicit

Sub NgocTuyen1995()

Dim i&, j&, t&, k&, Lr&, R&, LrWs&
Dim Arr(), KQ(), Res()
Dim Dic As Object, Fso As Object, Key
Dim Ws As Worksheet, Sh As Worksheet, Wb As Workbook
Dim File As Variant

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
Set Sh = Sheets("CTKM")
Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row
Arr = Sh.Range("A2:O" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To R
    Key = Arr(i, 4)
        If Not Dic.Exists(Key) Then Dic(Key) = i
Next i

Set Fso = CreateObject("Scripting.FileSystemObject")
For Each File In Fso.GetFolder("C:\Users\Admin\Downloads\NgocTuyen").Files
    If File.Name Like "Data.xlsx" Then
        Set Wb = Workbooks.Open(File)
        For Each Ws In Wb.Sheets
            If Ws.Name <> "All Store" Then
                LrWs = Ws.Cells(Rows.Count, "H").End(xlUp).Row
                Res = Ws.Range("A17:G" & LrWs).Value
                For i = 1 To UBound(Res)
                    If Dic.Exists(Res(i, 4)) Then
                        k = Dic.Item(Res(i, 4))
                        Res(i, 5) = Arr(k, 3)
                        Res(i, 7) = Arr(k, 9)
                    End If
                Next i
                    Ws.Range("A17:G" & LrWs) = Res
            End If
        Next Ws
        Wb.Save
'        Wb.Close
    End If
Next File
Set Dic = Nothing
Set Fso = Nothing
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox "Done"
End Sub

Khi bạn nhấn nút "Run" thì File Data.xlsx sẽ xuất hiện và dữ liệu được lấp vào các ô và cột mong muốn

Lưu ý: Đường dẫn của tôi có thể khác của bạn.
Hỏi bạn : 1/ Tại sao không để cho Vba tính luôn cột H của các sheet trong file Data nhỉ? 2/ Nếu các sheet (100123....,100123...) được lấy ra từ Sheet AllStore thì hoàn toàn có thể code để phân tích Sheet AllStore thành các sheet thành phần (100123....,100123...) theo 1 điều kiện nào đó.

 

[Maika8008]

Thân chào cả nhà GPEX!
Hiện tại em có 02 File:
1. File Data (bao gồm hơn 90 sheet - em chỉ demo 04 sheet thôi ạ)
2. File Danh sách (sheet CTKM và Sheet Run)
Em muốn tạo một nút button từ File Danh sách tại sheet Run để khi Click vào sẽ xuất hiện hộp thoại để select tới File Data và làm các bước:
1. Dựa vào Sheet CTKM (cột E - Barcode) Map với cột Barcode (cột D) ở File Data để lấy thông tin Sap code (cột C) từ Sheet CTKM qua file Data (Cột E) Sap Code theo các Sheet (trừ Sheet All Store).
2. Dựa vào Sheet CTKM (cột E - Barcode) Map với cột Barcode (cột D) ở File Data để lấy thông tin Giá bán ra (+VAT) từ Sheet CTKM qua file Data (cột G)theo các Sheet (trừ Sheet All Store).
3. Save New File kết quả (em có đính kèm file Demo kết quả cho dễ hiểu ý em ạ)

Vì số lượng sheet quá nhiều em làm bằng tay khá mất thời gian và công việc cứ 3 ngày lập lại 1 lần nên em khá khó khăn.
Mong cả nhà giúp đỡ, em chân thành cảm ơn ạ..

Bấm Run tại file đính kèm

 

[ngoctuyen1995]

Theo tôi bạn để File Data.xlsx trong cùng folder với file Danh sach.xlsm để khi chạy code bạn không cần phải chọn File data.xlsx nữa.

Trong khi chờ các giải pháp khác hãy tham khảo code sau:

Option Explicit

Sub NgocTuyen1995()

Dim i&, j&, t&, k&, Lr&, R&, LrWs&
Dim Arr(), KQ(), Res()
Dim Dic As Object, Fso As Object, Key
Dim Ws As Worksheet, Sh As Worksheet, Wb As Workbook
Dim File As Variant

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
Set Sh = Sheets("CTKM")
Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row
Arr = Sh.Range("A2:O" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To R
    Key = Arr(i, 4)
        If Not Dic.Exists(Key) Then Dic(Key) = i
Next i

Set Fso = CreateObject("Scripting.FileSystemObject")
For Each File In Fso.GetFolder("C:\Users\Admin\Downloads\NgocTuyen").Files
    If File.Name Like "Data.xlsx" Then
        Set Wb = Workbooks.Open(File)
        For Each Ws In Wb.Sheets
            If Ws.Name <> "All Store" Then
                LrWs = Ws.Cells(Rows.Count, "H").End(xlUp).Row
                Res = Ws.Range("A17:G" & LrWs).Value
                For i = 1 To UBound(Res)
                    If Dic.Exists(Res(i, 4)) Then
                        k = Dic.Item(Res(i, 4))
                        Res(i, 5) = Arr(k, 3)
                        Res(i, 7) = Arr(k, 9)
                    End If
                Next i
                    Ws.Range("A17:G" & LrWs) = Res
            End If
        Next Ws
        Wb.Save
'        Wb.Close
    End If
Next File
Set Dic = Nothing
Set Fso = Nothing
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox "Done"
End Sub

Khi bạn nhấn nút "Run" thì File Data.xlsx sẽ xuất hiện và dữ liệu được lấp vào các ô và cột mong muốn

Lưu ý: Đường dẫn của tôi có thể khác của bạn.
Hỏi bạn : 1/ Tại sao không để cho Vba tính luôn cột H của các sheet trong file Data nhỉ? 2/ Nếu các sheet (100123....,100123...) được lấy ra từ Sheet AllStore thì hoàn toàn có thể code để phân tích Sheet AllStore thành các sheet thành phần (100123....,100123...) theo 1 điều kiện nào đó.

Em cảm ơn

Theo tôi bạn để File Data.xlsx trong cùng folder với file Danh sach.xlsm để khi chạy code bạn không cần phải chọn File data.xlsx nữa.

Trong khi chờ các giải pháp khác hãy tham khảo code sau:

Option Explicit

Sub NgocTuyen1995()

Dim i&, j&, t&, k&, Lr&, R&, LrWs&
Dim Arr(), KQ(), Res()
Dim Dic As Object, Fso As Object, Key
Dim Ws As Worksheet, Sh As Worksheet, Wb As Workbook
Dim File As Variant

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
Set Sh = Sheets("CTKM")
Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row
Arr = Sh.Range("A2:O" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To R
    Key = Arr(i, 4)
        If Not Dic.Exists(Key) Then Dic(Key) = i
Next i

Set Fso = CreateObject("Scripting.FileSystemObject")
For Each File In Fso.GetFolder("C:\Users\Admin\Downloads\NgocTuyen").Files
    If File.Name Like "Data.xlsx" Then
        Set Wb = Workbooks.Open(File)
        For Each Ws In Wb.Sheets
            If Ws.Name <> "All Store" Then
                LrWs = Ws.Cells(Rows.Count, "H").End(xlUp).Row
                Res = Ws.Range("A17:G" & LrWs).Value
                For i = 1 To UBound(Res)
                    If Dic.Exists(Res(i, 4)) Then
                        k = Dic.Item(Res(i, 4))
                        Res(i, 5) = Arr(k, 3)
                        Res(i, 7) = Arr(k, 9)
                    End If
                Next i
                    Ws.Range("A17:G" & LrWs) = Res
            End If
        Next Ws
        Wb.Save
'        Wb.Close
    End If
Next File
Set Dic = Nothing
Set Fso = Nothing
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox "Done"
End Sub

Khi bạn nhấn nút "Run" thì File Data.xlsx sẽ xuất hiện và dữ liệu được lấp vào các ô và cột mong muốn

Lưu ý: Đường dẫn của tôi có thể khác của bạn.
Hỏi bạn : 1/ Tại sao không để cho Vba tính luôn cột H của các sheet trong file Data nhỉ? 2/ Nếu các sheet (100123....,100123...) được lấy ra từ Sheet AllStore thì hoàn toàn có thể code để phân tích Sheet AllStore thành các sheet thành phần (100123....,100123...) theo 1 điều kiện nào đó.

Em cảm ơn anh đã quan tâm và giúp đỡ em ạ, nhờ anh hướng dẫn mà em là được rồi ạ, chúc anh Sức khỏe và thành công ạ..

Bài đã được tự động gộp: 24/3/23

Bấm Run tại file đính kèm

Em cảm ơn anh đã quan tâm và giúp đỡ em ạ, nhờ anh File của anh mà em là được rồi ạ, chúc anh Sức khỏe và thành công ạ..