ACE giúp em Tổng hợp nhiều sheet vào 1 sheet bằng VBA

[tvl297]

em nhờ anh chị giúp em tổng hợp các sheet trong file em gửi. thanhk

 

[hoangtuaotrang_hp_vn]

em nhờ anh chị giúp em tổng hợp các sheet trong file em gửi. thanhk

tham gia diễn đàn từ 2008 mà cái tiêu đề kìa

 

[tvl297]

tham gia diễn đàn từ 2008 mà cái tiêu đề kìa

mh bận mấy năm rồi ko có tham gia được. nên giờ bỡ ngỡ bạn thông cảm

 

[biboylenka1]

em nhờ anh chị giúp em tổng hợp các sheet trong file em gửi. thanhk

Sub Tong_hop()
Dim Sh As Worksheet
    For Each Sh In ActiveWorkbook.Sheets
        If Sh.Name <> Sheet1.Name Then
            Sh.Range("B3:E" & Sh.Range("B" & Rows.Count).End(xlUp).Row).Copy
            Sheet1.Range("B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
        End If
    Next Sh
End Sub

Bạn ở Sơn La hả?

 

[tvl297]

Sub Tong_hop()
Dim Sh As Worksheet
    For Each Sh In ActiveWorkbook.Sheets
        If Sh.Name <> Sheet1.Name Then
            Sh.Range("B3:E" & Sh.Range("B" & Rows.Count).End(xlUp).Row).Copy
            Sheet1.Range("B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
        End If
    Next Sh
End Sub

Bạn ở Sơn La hả?

trược mh làm sơn la giờ về thái bình rồi bạn à

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

Sub Tong_hop()
Dim Sh As Worksheet
    For Each Sh In ActiveWorkbook.Sheets
        If Sh.Name <> Sheet1.Name Then
            Sh.Range("B3:E" & Sh.Range("B" & Rows.Count).End(xlUp).Row).Copy
            Sheet1.Range("B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
        End If
    Next Sh
End Sub

Bạn ở Sơn La hả?

mình chạy được rồi cảm ơn bạn nhé

 

[biboylenka1]

minh thử nhưng chạy ko ra kết quả bạn à

Tình trạng nó như thế nào vậy bạn? Không ra như thế nào vậy?

 

[tvl297]

Bạn giúp Minh khi mh update thêm dữ liệu thì xóa dữ liệu cũ đi với. mà ở các sheet cột D có dữ liệu thì mới copy vào tổng hợp. Mình cảm ơn ạ

 

[hoangtuaotrang_hp_vn]

Dùng Power Query cho nhanh gọn

 

[Hoàng Tuấn 868]

Dùng Power Query cho nhanh gọn

Tiêu đề vẫn lỗi kìa.

 

[tvl297]

Tiêu đề vẫn lỗi kìa.

mình ko hiểu lỗi gì đấy bạn

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

Dùng Power Query cho nhanh gọn

mình dùng office 2007 bạn ơi

 

[Hoàng Tuấn 868]

mình ko hiểu lỗi gì đấy bạn

Bạn chịu khó đọc lại Nội quy nhé.

 

[SA_DQ]

Sub TongHop()
 Dim Sh As Worksheet, Rng As Range, WF As Object, sRng As Range
 Dim fDat As Date, lDat As Date, Rws As Long, SoNgay As Integer, J As Long
 Dim MyAdd As String:                   Dim Cot As Integer, W As Long
 
 fDat = 999 + Date
 Set WF = Application.WorksheetFunction
1 'Tìm Các Ngày Cuc Tri  '
 For Each Sh In ThisWorkbook.Worksheets
    If IsNumeric(Right(Sh.Name, 1)) Then
        Rws = Sh.UsedRange.Rows.Count
        Set Rng = Sh.[b1].Resize(Rws)
        If WF.Min(Rng) < fDat Then fDat = WF.Min(Rng)
        If WF.Max(Rng) > lDat Then lDat = WF.Max(Rng)
        W = W + Rws
    End If
 Next Sh
2 ' Thông Kê Theo Ngày      '
 Sheets("THop").Select :                 Set WF = Nothing
 J = [b3].CurrentRegion.Columns.Count
 [b3].Resize([b3].CurrentRegion.Rows.Count, J).ClearContents
 SoNgay = lDat - fDat + 1
 ReDim Arr(1 To W, 1 To 4):             W = 0
 For J = 0 To SoNgay
    For Each Sh In ThisWorkbook.Worksheets
        If IsNumeric(Right(Sh.Name, 1)) Then
            Rws = Sh.UsedRange.Rows.Count
            Set Rng = Sh.[b3].Resize(Rws)
            Rng.NumberFormat = "MM/DD/yyyy"
            Set sRng = Rng.Find(Format(fDat + J, "MM/DD/yyyy"), , xlValues, xlWhole)
            If Not sRng Is Nothing Then
                MyAdd = sRng.Address
                Do
                    W = W + 1:          Arr(W, 1) = J + fDat
                    For Cot = 1 To 3
                        Arr(W, Cot + 1) = sRng.Offset(, Cot).Value
                    Next Cot
                    Set sRng = Rng.FindNext(sRng)
                Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
            End If
        End If
    Next Sh
 Next
 If W Then [b3].Resize(W, 4).Value = Arr()
End Sub

 

[VetMini]

Bạn chịu khó đọc lại Nội quy nhé.

Mùa Tết nhứt. Bà con hơi đói bài. Khi 1 câu hỏi vẫn có vài câu trả lời thì người ta rảnh mà đọc bài của bạn?

 

[SA_DQ]

Nếu chủ bài đăng không chịu sửa tiêu đề thì chứng tỏ không cần hiểu biết Excel!

III. Quy định về tiêu đề bài viết:Tiêu đề bài viết phải sử dụng bằng tiếng Việt có dấu đầy đủ
1. Tiêu đề bài viết phải sử dụng tiếng Việt có dấu (ngoại trừ tiêu đề cho bài trong box Ngoại ngữ).
2. Tiêu đề cần phù hợp với nội dung và phù hợp một cách tương đối với các mục diễn đàn (box) mà thành viên gửi vào.
3. Tiêu đề cần được ghi rõ nghĩa, không được đặt những tiêu đề như: "Chỉ cho tôi với", "Help me", "Quan trọng đây!!!????", "Vào đây coi này", "Hay lắm", "Giúp mình với", "Admin ơi", v.v...

 

[tvl297]

Nếu bài viết không chịu sửa tiêu đề, thì chứng chỉ không cần hiểu về Excel!

MH tìm chỗ sửa mãi mà ko được, bạn chỉ mình chỗ sửa được ko

 

[HUONGHCKT]

MH tìm chỗ sửa mãi mà ko được, bạn chỉ mình chỗ sửa được ko

Những chỗ in đậm đó là gì? trước đó là ACE là gì?Bạn cần đọc lại thật kỹ nội quy của diễn đàn.