Xin hỗ trợ VBA tổng hợp số liệu từ nhiều sheet

[nmdong.dbi]

Hiện tại mình đang có rất nhiều file dữ liệu cần tổng hợp chung vào 1 file excel. Mỗi file excel lẻ có 16 sheet. Nhưng thực tế mình chỉ sử dụng số liệu ở sheet 1,2,3,4 ( tương ứng với số liệu của 4 quý trong năm )
Mình đã có code để ghép nhiều file excel vào thành 1 file và code để xóa các sheet ko dùng đến.
Vấn đề đặt ra bây giờ là: Sau khi đã ghép file xong mình làm cách nào để tổng hợp được số liệu của cột N ở tất cả các sheet chứa dữ liệu ào cột D với MST tương ứng của sheet có tên TH
Em đang tính làm theo cách tổng hợp số liệu ở tất cả các sheet vào sheet có tên DATA với MST tương ứng để dùng hàm sumif tính tổng cho từng MST sang sheet TH
Bác nào có thể giúp em hoàn thiện được không ạ? Em cảm ơn các bác !

 

[Nhattanktnn]

Hiện tại mình đang có rất nhiều file dữ liệu cần tổng hợp chung vào 1 file excel. Mỗi file excel lẻ có 16 sheet. Nhưng thực tế mình chỉ sử dụng số liệu ở sheet 1,2,3,4 ( tương ứng với số liệu của 4 quý trong năm )
Mình đã có code để ghép nhiều file excel vào thành 1 file và code để xóa các sheet ko dùng đến.
Vấn đề đặt ra bây giờ là: Sau khi đã ghép file xong mình làm cách nào để tổng hợp được số liệu của cột N ở tất cả các sheet chứa dữ liệu ào cột D với MST tương ứng của sheet có tên TH
Em đang tính làm theo cách tổng hợp số liệu ở tất cả các sheet vào sheet có tên DATA với MST tương ứng để dùng hàm sumif tính tổng cho từng MST sang sheet TH
Bác nào có thể giúp em hoàn thiện được không ạ? Em cảm ơn các bác !

Bạn xem thử:

Sub TongCong()
Dim sArr(), Res(), Ws As Worksheet, Lr As Long, RngSum As Range, Txt1 As String, Txt2 As String
Application.ScreenUpdating = False
With Sheets("TH")
    Lr = .Range("B" & Rows.Count).End(xlUp).Row
         .Range("D9:D" & Lr).ClearContents
    sArr = .Range("B9:B" & Lr).Value
End With
ReDim Res(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr, 1)
    Txt1 = sArr(i, 1)
    For Each Ws In ActiveWorkbook.Worksheets
        If InStr(Ws.Name, "Sheet") > 0 Then
            Txt2 = Ws.Range("D9").Value
            If Txt1 = Txt2 Then
                Set RngSum = Ws.Range("N18:N" & Ws.Range("N" & Rows.Count).End(xlUp).Row)
                Res(i, 1) = Res(i, 1) + Application.WorksheetFunction.Sum(RngSum)
            End If
        End If
    Next
Next
Sheets("TH").Range("D9").Resize(UBound(sArr, 1), 1) = Res
Application.ScreenUpdating = True
End Sub

 

[nmdong.dbi]

Bạn xem thử:
....
Dạ đúng chuẩn luôn rồi ạ. Em cảm ơn bác nhiều lắm ạ.
Em muốn nhờ thêm 1 chút xíu là em có code ghép các sheet từ nhiều file excel như thế này. Giờ khi ghép em chỉ muốn ghép các sheet 1,2,3,4 của file đó vào file tổng hợp thôi thì làm như thế nào ạ? Em cảm ơn bác

Sub copyfile()
Path = ""
Filename = Dir(Path & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

 

[Nhattanktnn]

sửa dòng này nè bạn:

For Each Sheet In ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))

 

[nmdong.dbi]

sửa dòng này nè bạn:

For Each Sheet In ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))

Yêu bác quá luôn ạ ! Thank so much !

 

[Nhattanktnn]

Yêu bác quá luôn ạ ! Thank so much !

Bạn thử chưa

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

Hoặc bạn có thể thử sub này để copy file (có thể chọn folder tùy ý, và có thể đặt file chính chung folder):

Sub Copy_File()
Application.ScreenUpdating = False
Dim MainWB As Workbook, Ws As Worksheet, SubWB As Workbook, sFile As Object, Fso As Object, Chk As Boolean, Fpath As String, SheetArr()
Set MainWB = ThisWorkbook
Set Fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
    Chk = .Show
    If Not Chk Then Exit Sub
    Fpath = .SelectedItems(1)
End With
For Each sFile In Fso.getfolder(Fpath).Files
    If Fso.GetExtensionName(sFile) Like "xls*" And InStr(MainWB.Name, Fso.getbasename(sFile)) = 0 And InStr(Fso.getbasename(sFile), "~$") = 0 Then
        Workbooks.Open sFile
        Set SubWB = ActiveWorkbook
        SheetArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
            For Each Ws In SubWB.Sheets(SheetArr)
                Ws.Copy after:=MainWB.Sheets(MainWB.Sheets.Count)
            Next
        SubWB.Close False
    End If
Next
Set Fso = Nothing
Application.ScreenUpdating = True
End Sub

 

[nmdong.dbi]

Bạn thử chưa

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

Hoặc bạn có thể thử sub này để copy file (có thể chọn folder tùy ý, và có thể đặt file chính chung folder):
.....

Dạ em test thử được ngon luôn rồi bác. Cảm ơn bác đã tận tình nhiều lắm luôn ạ !

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

Code của bác cho xịn xò hơn ạ. Hiện lên cửa sổ để mình chọn foder chứa file.
Em muốn hỏi thêm một chút là em đang dùng code để xóa hết các sheet hoặc tùy chọn. Giờ em muốn sửa code thành chỉ để lại sheet có tên TH và RUN còn lại các sheet khác xóa hết thì làm ntn ạ bác ?

Sub XoaSheets()
Dim Ws As Worksheet, i As Long, tmp, tmp1
tmp = MsgBox("Chon Yes neu Xoa tat ca cac Sheet" & vbCr & _
"Chon No neu chi Xoa cac sheet duoc chon" _
, vbYesNo, "WARNING: Delete All sheets in workbook")


If tmp = vbYes Then tmp1 = MsgBox("Chon Yes neu thuc su Delete tat ca cac Sheet" & vbCr & _
"Chon No neu huy lenh Delete" _
, vbYesNo, "WARNING: Sheets Delete không the khoi phuc!!!")
If tmp1 = vbNo Then Exit Sub


Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each Ws In Worksheets
If Ws.Name <> ActiveSheet.Name Then
If tmp = vbYes Then
Ws.Delete
Else
tmp1 = MsgBox("Chon Yes neu thuc su Delete Sheet : " & Ws.Name & vbCr & _
"Chon No neu khong muon Delete Sheet: " & Ws.Name _
, vbYesNo, "WARNING: Sheets Delete không the khoi phuc!!!")
If tmp1 = vbYes Then
Ws.Delete
End If
End If
End If
Next Ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[Nhattanktnn]

For Each Ws In Worksheets
If Ws.Name <> ActiveSheet.Name Then

Thử sửa chỗ này thành:

For Each Ws In Worksheets
If Ws.Name <> ActiveSheet.Name and  Ws.Name <> "TH" Then

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

Mà nó chỉ cần ngắn gọn thế này thôi:

Sub XoaSheets()
Dim ws As Worksheet, tmp As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False
tmp = MsgBox("Ten sheet khac " & Chr(34) & "TH" & Chr(34) & " va " & Chr(34) & "RUN" & Chr(34) & " se bi xoa" _
, vbYesNo, "WARNING:   Xoa sheet")
If tmp = vbNo Then Exit Sub
    For Each ws In Worksheets
        If ws.Name <> "RUN" And ws.Name <> "TH" Then
                ws.Delete
        End If
    Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[nmdong.dbi]

......
Da Dạ em vừa test thử rồi ạ. Code của bác đúng cái em muốn luôn. Xóa hết chỉ giữ lại TH và RUN. Em cảm ơn bác nhiều lắm ạ !

 

[Nhattanktnn]

......
Da Dạ em vừa test thử rồi ạ. Code của bác đúng cái em muốn luôn. Xóa hết chỉ giữ lại TH và RUN. Em cảm ơn bác nhiều lắm ạ !

Mà đề này phát sinh hơi nhiều đó nhá

 

[nmdong.dbi]

Dạ vâng ạ. Em cũng mới tìm hiểu về VBA nên cũng nhiều cái chưa biết lắm. Cũng quên mất là trên diễn đàn mình cũng có nhiều bài viết có nội dung liên quan rồi. Lần tới em sẽ cố gắng tìm trước khi hỏi ạ. Hihi. Gặp cao thủ như bác thì vấn đề được giải quyết nhanh hơn ạ

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

Mà đề này phát sinh hơi nhiều đó nhá

Dạ vâng ạ. Em cũng mới tìm hiểu về VBA nên cũng nhiều cái chưa biết lắm. Cũng quên mất là trên diễn đàn mình cũng có nhiều bài viết có nội dung liên quan rồi. Lần tới em sẽ cố gắng tìm trước khi hỏi ạ. Hihi. Gặp cao thủ như bác thì vấn đề được giải quyết nhanh hơn ạ

 

[nmdong.dbi]

Mà đề này phát sinh hơi nhiều đó nhá

Dạ em xin phép được nhờ bác một lần nữa ạ.
Hiện tại em đang cần lấy dữ liệu từ website chạy trên nền IE.
Em có một file Excel có sẵn điều kiện để nhập vào web như MST(cộtB) và các dữ liệu điều kiện khác (cột D,E,F,G).
Sau khi nhập web xong web sẽ cho kết xuất file và em muốn lưu file đó vào một tệp bất kỳ do mình lựa chọn
Em gửi báo hình ảnh và mô tả xem có Code VBA nào khả thi không ạ. Em cảm ơn bác.

 

[Nhattanktnn]

Dạ em xin phép được nhờ bác một lần nữa ạ.
Hiện tại em đang cần lấy dữ liệu từ website chạy trên nền IE.
Em có một file Excel có sẵn điều kiện để nhập vào web như MST(cộtB) và các dữ liệu điều kiện khác (cột D,E,F,G).
Sau khi nhập web xong web sẽ cho kết xuất file và em muốn lưu file đó vào một tệp bất kỳ do mình lựa chọn
Em gửi báo hình ảnh và mô tả xem có Code VBA nào khả thi không ạ. Em cảm ơn bác.

Cũng muốn giúp bạn nhưng khả năng của mình hạn hẹp, bạn đăng bài mới và nói rõ mục đích để được các bác trên diễn đàn giúp đỡ nhé!

 

[nmdong.dbi]

Cũng muốn giúp bạn nhưng khả năng của mình hạn hẹp, bạn đăng bài mới và nói rõ mục đích để được các bác trên diễn đàn giúp đỡ nhé!

Vâng ạ. Em cảm ơn bác !