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

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
Hoangquyenbong

Hoangquyenbong

Thành viên hoạt động
Tham gia
13/7/18
Bài viết
199
Được thích
38
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 đỡ ạ !
 

File đính kèm

  • GopDuLieu.xlsx
    31.8 KB · Đọc: 25
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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 đỡ ạ !
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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 đỡ ạ !
Nhấp chuột vào đây để mở rộng...
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 ý.
 
Upvote 0
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 ý.
Nhấp chuột vào đây để mở rộng...
Giống nhau tới tận cách nghĩ luôn.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Mình cảm ơn bạn đã giúp, mình chạy sẽ chạy thử.
Bài đã được tự động gộp:

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 ý.
Nhấp chuột vào đây để mở rộng...
Mình cảm ơn bạn nhiều, mình chạy thử xem sao.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

[/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
Nhấp chuột vào đây để mở rộng...
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:

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 ý.
Nhấp chuột vào đây để mở rộng...
Mình cảm ơn bạn nhiều, mình đã chạy thử và đúng như mình mong muốn ạ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
Trích Lọc dữ liệu với Macro
Trả lời
18
Đọc
1K
HTN033
H
LuuAnh980
Filter lọc có "mm" mà không thấy.
Trả lời
3
Đọc
75
VetMini
V
C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
3
Đọc
74
VetMini
V
pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
4
Đọc
118
VetMini
V
C
  • Question
Tạo schedule chạy code VBA
Trả lời
8
Đọc
260
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom