Nhờ anh chị hỗ trợ copy dữ liệu từ nhiều sheet sang sheet tổng hợp bằng VBA

[Taiclub]

Em có 1 file đính kèm. trong sheet gồm có Xuất kho 1, Xuất kho 2......Em muốn nhờ anh chị giúp em dùng code VBA để copy chữ trong sheet Xuất kho 1, Xuất kho 2 sang sheet Tổng Hợp. Copy và paste vào file tổng hợp nối tiếp nhau. Em cảm ơn anh chị dã hỡ trợ

 

[giaiphap]

Em có 1 file đính kèm. trong sheet gồm có Xuất kho 1, Xuất kho 2......Em muốn nhờ anh chị giúp em dùng code VBA để copy chữ trong sheet Xuất kho 1, Xuất kho 2 sang sheet Tổng Hợp. Copy và paste vào file tổng hợp nối tiếp nhau. Em cảm ơn anh chị dã hỡ trợ

Dùng thử code này.

Sub GPE()
    Dim iRow%, cRow%, sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            iRow = sh.Range("A1000000").End(xlUp).Row
            cRow = Application.WorksheetFunction.Max(Sheet4.Range("A1000000").End(xlUp).Row, 1) + 2
            sh.Range("A6:C" & iRow).Copy Sheet4.Range("A" & cRow)
        End If
    Next sh
End Sub

 

[HUONGHCKT]

Em có 1 file đính kèm. trong sheet gồm có Xuất kho 1, Xuất kho 2......Em muốn nhờ anh chị giúp em dùng code VBA để copy chữ trong sheet Xuất kho 1, Xuất kho 2 sang sheet Tổng Hợp. Copy và paste vào file tổng hợp nối tiếp nhau. Em cảm ơn anh chị dã hỡ trợ

Trong khi chờ các anh chị em khác hỗ trợ bằng Pivot Table, hay Power query thì hãy thử đoạn code VBA này xem sao.

vv
Sub TONGHOP()
Dim Arr(), KQ(), S
Dim k&, t&, Lr&, Rdau&
Dim Sh As Worksheet, Rng As Range, sRng As Range

ReDim KQ(1 To 118, 1 To 24)
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Tonghop" Then
        t = t + 1
        Lr = Sh.Cells(Rows.Count, 1).End(3).Row
        Set Rng = Sh.Range("A1:A" & Lr)
        Set sRng = Rng.Find("STT")
            If Not sRng Is Nothing Then
                Rdau = sRng.Row
                    If t = 1 Then
                        Sh.Range("A1:C" & Lr).Copy Sheets("TONGHOP").[A1]
                    Else
                        k = Sheets("TONGHOP").Cells(Rows.Count, 1).End(3).Row + 2
                        Sh.Range(Sh.Cells(Rdau, 1), Sh.Cells(Lr, 3)).Copy Sheets("TONGHOP").Range("A" & k)
                    End If
            End If
    End If
Next Sh
Set Rng = Nothing: Set sRng = Nothing

 

[Taiclub]

Sub GPE()
Dim iRow%, cRow%, sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "TONGHOP" Then
iRow = sh.Range("A1000000").End(xlUp).Row
cRow = Application.WorksheetFunction.Max(Sheet4.Range("A1000000").End(xlUp).Row, 1) + 2
sh.Range("A6:C" & iRow).Copy Sheet4.Range("A" & cRow)
End If
Next sh
End Sub

Dạ em cảm ơn vì đã trợ giúp em ạ .Em đã làm thành công rồi ạ. Cho em hỏi thêm 1 phần nữa là nếu trong bảng là công thức liên kết thì bảng tổng hợp nó ko ra chữ ạ mà là =0 . Xin hướng dẫn em thêm phần này ạ. Em cảm ơn các anh chị nhiều.

 

[giaiphap]

Dạ em cảm ơn vì đã trợ giúp em ạ .Em đã làm thành công rồi ạ. Cho em hỏi thêm 1 phần nữa là nếu trong bảng là công thức liên kết thì bảng tổng hợp nó ko ra chữ ạ mà là =0 . Xin hướng dẫn em thêm phần này ạ. Em cảm ơn các anh chị nhiều.

Rút kinh nghiệm, mai mốt có hỏi bài phải đưa dữ liệu đúng thực tế.

Sub GPE()
    Dim iRow%, cRow%, sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            iRow = sh.Range("A1000000").End(xlUp).Row
            cRow = Application.WorksheetFunction.Max(Sheet4.Range("A1000000").End(xlUp).Row, 1) + 2
            sh.Range("A6:C" & iRow).Copy
            Sheet4.Range("A" & cRow).PasteSpecial Paste:=xlPasteValues
        End If
    Next sh
    Application.CutCopyMode = False
End Sub