Lấy toàn bộ thông tin vùng dữ liệu của nhiều sheet về 1 sheet trong excel. (1 người xem)

Hoangquyenbong · 20/3/23

Kính nhờ các thành viên trên diễn đàn !
Em có 1 file excel ví dụ để nhờ các thành viên giúp đỡ ạ. Chi tiết em đã ghi trong sheet DienGiai ạ.
Em cảm ơn và mong nhận được sự giúp đỡ ạ !

BuiQuangThuan · 20/3/23

Hoangquyenbong đã viết:
Kính nhờ các thành viên trên diễn đàn !
Em có 1 file excel ví dụ để nhờ các thành viên giúp đỡ ạ. Chi tiết em đã ghi trong sheet DienGiai ạ.
Em cảm ơn và mong nhận được sự giúp đỡ ạ !

Thử code sau : .....

Mã:

Sub TongHop()
    Dim Rng As Range, Ws As Worksheet, iRow&, Vung As Range, iCol&, iR&
    For Each Ws In Worksheets
        If Ws.Name <> "TongHop" Then
            Set Vung = Ws.Range("B:B")
            If Not Vung.Find("TOTAL") Is Nothing Then
                iRow = Vung.Find("TOTAL").Row
                iCol = Ws.Range("B10").CurrentRegion.Columns.Count
                If iRow > 9 Then
                    Set Rng = Ws.Range("B9").Resize(iRow - 8, iCol)
                Else
                    GoTo Tiep
                End If
                With Sheets("TongHop")
                    iR = .Range("A" & Rows.Count).End(3).Row + 1
                    If iR < 9 Then iR = 9 Else iR = iR
                    .Range("A" & iR).Resize(iRow - 8) = Ws.Name
                    Rng.Copy .Range("B" & iR)
                End With
            End If
        End If
Tiep:
    Next
End Sub

HUONGHCKT · 20/3/23

Hoangquyenbong đã viết:
Kính nhờ các thành viên trên diễn đàn !
Em có 1 file excel ví dụ để nhờ các thành viên giúp đỡ ạ. Chi tiết em đã ghi trong sheet DienGiai ạ.
Em cảm ơn và mong nhận được sự giúp đỡ ạ !

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

Mã:

Option Explicit

Sub Gop()
Dim i&, Lr&, t&, R&, Col&, d&
Dim Rng As Range
Dim Ws As Worksheet, Sh As Worksheet
Set Sh = Sheets("TongHop")
For Each Ws In Worksheets
    If Ws.Name <> "TongHop" Then
        If Not Ws.Range("B9:B10000").Find("TOTAL") Is Nothing Then
            R = Ws.Range("B9:B10000").Find("TOTAL").Row
            Col = Ws.Cells(10, 1000).End(xlToLeft).Column
            Set Rng = Ws.Range(Ws.Cells(9, 2), Ws.Cells(R, Col))
            d = Rng.Rows.Count
            Lr = Sh.Range("B10000").End(xlUp).Row + 1
            If Lr < 9 Then Lr = 9
            Rng.Copy Sh.Range("B" & Lr)
            Sh.Range("A" & Lr).Resize(d, 1) = Ws.Name
        End If
    End If
Next Ws
MsgBox "done"
End Sub

Hy vọng đúng ý.

BuiQuangThuan · 20/3/23

HUONGHCKT đã viết:

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

Mã:

Option Explicit

Sub Gop()
Dim i&, Lr&, t&, R&, Col&, d&
Dim Rng As Range
Dim Ws As Worksheet, Sh As Worksheet
Set Sh = Sheets("TongHop")
For Each Ws In Worksheets
    If Ws.Name <> "TongHop" Then
        If Not Ws.Range("B9:B10000").Find("TOTAL") Is Nothing Then
            R = Ws.Range("B9:B10000").Find("TOTAL").Row
            Col = Ws.Cells(10, 1000).End(xlToLeft).Column
            Set Rng = Ws.Range(Ws.Cells(9, 2), Ws.Cells(R, Col))
            d = Rng.Rows.Count
            Lr = Sh.Range("B10000").End(xlUp).Row + 1
            If Lr < 9 Then Lr = 9
            Rng.Copy Sh.Range("B" & Lr)
            Sh.Range("A" & Lr).Resize(d, 1) = Ws.Name
        End If
    End If
Next Ws
MsgBox "done"
End Sub

Hy vọng đúng ý.

Giống nhau tới tận cách nghĩ luôn.

Hoangquyenbong · 20/3/23

BuiQuangThuan đã viết:

Thử code sau : .....

Mã:

Sub TongHop()
    Dim Rng As Range, Ws As Worksheet, iRow&, Vung As Range, iCol&, iR&
    For Each Ws In Worksheets
        If Ws.Name <> "TongHop" Then
            Set Vung = Ws.Range("B:B")
            If Not Vung.Find("TOTAL") Is Nothing Then
                iRow = Vung.Find("TOTAL").Row
                iCol = Ws.Range("B10").CurrentRegion.Columns.Count
                If iRow > 9 Then
                    Set Rng = Ws.Range("B9").Resize(iRow - 8, iCol)
                Else
                    GoTo Tiep
                End If
                With Sheets("TongHop")
                    iR = .Range("A" & Rows.Count).End(3).Row + 1
                    If iR < 9 Then iR = 9 Else iR = iR
                    .Range("A" & iR).Resize(iRow - 8) = Ws.Name
                    Rng.Copy .Range("B" & iR)
                End With
            End If
        End If
Tiep:
    Next
End Sub

Mình cảm ơn bạn đã giúp, mình chạy sẽ chạy thử.

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

HUONGHCKT đã viết:

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

Mã:

Option Explicit

Sub Gop()
Dim i&, Lr&, t&, R&, Col&, d&
Dim Rng As Range
Dim Ws As Worksheet, Sh As Worksheet
Set Sh = Sheets("TongHop")
For Each Ws In Worksheets
    If Ws.Name <> "TongHop" Then
        If Not Ws.Range("B9:B10000").Find("TOTAL") Is Nothing Then
            R = Ws.Range("B9:B10000").Find("TOTAL").Row
            Col = Ws.Cells(10, 1000).End(xlToLeft).Column
            Set Rng = Ws.Range(Ws.Cells(9, 2), Ws.Cells(R, Col))
            d = Rng.Rows.Count
            Lr = Sh.Range("B10000").End(xlUp).Row + 1
            If Lr < 9 Then Lr = 9
            Rng.Copy Sh.Range("B" & Lr)
            Sh.Range("A" & Lr).Resize(d, 1) = Ws.Name
        End If
    End If
Next Ws
MsgBox "done"
End Sub

Hy vọng đúng ý.

Mình cảm ơn bạn nhiều, mình chạy thử xem sao.

Hoangquyenbong · 20/3/23

BuiQuangThuan đã viết:

Thử code sau : .....

Mã:

Sub TongHop()
    Dim Rng As Range, Ws As Worksheet, iRow&, Vung As Range, iCol&, iR&
    For Each Ws In Worksheets
        If Ws.Name <> "TongHop" Then
            Set Vung = Ws.Range("B:B")
            If Not Vung.Find("TOTAL") Is Nothing Then
                iRow = Vung.Find("TOTAL").Row
                iCol = Ws.Range("B10").CurrentRegion.Columns.Count
                If iRow > 9 Then
                    Set Rng = Ws.Range("B9").Resize(iRow - 8, iCol)
                Else
                    GoTo Tiep
                End If
                With Sheets("TongHop")
                    iR = .Range("A" & Rows.Count).End(3).Row + 1
                    If iR < 9 Then iR = 9 Else iR = iR
                    .Range("A" & iR).Resize(iRow - 8) = Ws.Name
                    Rng.Copy .Range("B" & iR)
                End With
            End If
        End If
Tiep:
    Next
End Sub[
[QUOTE="BuiQuangThuan, post: 1098220, member: 420372"]
Thử code sau :    .....
[CODE]Sub TongHop()
    Dim Rng As Range, Ws As Worksheet, iRow&, Vung As Range, iCol&, iR&
    For Each Ws In Worksheets
        If Ws.Name <> "TongHop" Then
            Set Vung = Ws.Range("B:B")
            If Not Vung.Find("TOTAL") Is Nothing Then
                iRow = Vung.Find("TOTAL").Row
                iCol = Ws.Range("B10").CurrentRegion.Columns.Count
                If iRow > 9 Then
                    Set Rng = Ws.Range("B9").Resize(iRow - 8, iCol)
                Else
                    GoTo Tiep
                End If
                With Sheets("TongHop")
                    iR = .Range("A" & Rows.Count).End(3).Row + 1
                    If iR < 9 Then iR = 9 Else iR = iR
                    .Range("A" & iR).Resize(iRow - 8) = Ws.Name
                    Rng.Copy .Range("B" & iR)
                End With
            End If
        End If
Tiep:
    Next
End Sub

[/QUOTE]

BuiQuangThuan đã viết:

Thử code sau : .....

Mã:

Sub TongHop()
    Dim Rng As Range, Ws As Worksheet, iRow&, Vung As Range, iCol&, iR&
    For Each Ws In Worksheets
        If Ws.Name <> "TongHop" Then
            Set Vung = Ws.Range("B:B")
            If Not Vung.Find("TOTAL") Is Nothing Then
                iRow = Vung.Find("TOTAL").Row
                iCol = Ws.Range("B10").CurrentRegion.Columns.Count
                If iRow > 9 Then
                    Set Rng = Ws.Range("B9").Resize(iRow - 8, iCol)
                Else
                    GoTo Tiep
                End If
                With Sheets("TongHop")
                    iR = .Range("A" & Rows.Count).End(3).Row + 1
                    If iR < 9 Then iR = 9 Else iR = iR
                    .Range("A" & iR).Resize(iRow - 8) = Ws.Name
                    Rng.Copy .Range("B" & iR)
                End With
            End If
        End If
Tiep:
    Next
End Sub

Mình cảm ơn bạn nhiều, mình đã chạy thử và đúng như mình mong muốn ạ

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

HUONGHCKT đã viết:

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

Mã:

Option Explicit

Sub Gop()
Dim i&, Lr&, t&, R&, Col&, d&
Dim Rng As Range
Dim Ws As Worksheet, Sh As Worksheet
Set Sh = Sheets("TongHop")
For Each Ws In Worksheets
    If Ws.Name <> "TongHop" Then
        If Not Ws.Range("B9:B10000").Find("TOTAL") Is Nothing Then
            R = Ws.Range("B9:B10000").Find("TOTAL").Row
            Col = Ws.Cells(10, 1000).End(xlToLeft).Column
            Set Rng = Ws.Range(Ws.Cells(9, 2), Ws.Cells(R, Col))
            d = Rng.Rows.Count
            Lr = Sh.Range("B10000").End(xlUp).Row + 1
            If Lr < 9 Then Lr = 9
            Rng.Copy Sh.Range("B" & Lr)
            Sh.Range("A" & Lr).Resize(d, 1) = Ws.Name
        End If
    End If
Next Ws
MsgBox "done"
End Sub

Hy vọng đúng ý.

Mình cảm ơn bạn nhiều, mình đã chạy thử và đúng như mình mong muốn ạ

Hoàng Tuấn 868 · 20/3/23

BuiQuangThuan đã viết:
Giống nhau tới tận cách nghĩ luôn.

Vậy lẽ ra chủ bài chỉ cần thử một trong hai bài #2 hoặc #3 thôi.

Lấy toàn bộ thông tin vùng dữ liệu của nhiều sheet về 1 sheet trong excel. (1 người xem)

Người dùng đang xem chủ đề này

Hoangquyenbong

Thành viên thường trực

File đính kèm

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

HUONGHCKT

Zalo 0986997214

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Hoangquyenbong

Thành viên thường trực

Hoangquyenbong

Thành viên thường trực

Hoàng Tuấn 868

Đăng ký hôm qua

Bài viết mới nhất

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

Thời gian đếm ngược.