Nhờ trợ giúp code coppy các bảng dữ liệu có cấu trúc giống nhau vào một (1 người xem)

Liên hệ QC

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

Binbo2020

Thành viên tích cực
Tham gia
10/11/11
Bài viết
955
Được thích
962
Mình có một file bao gồm các name vattu_TH, ton_TH, hachtoan_TH tại các sheet khác nhau. Nhờ mọi người trợ giúp code để cóp dữ liệu cả 3 bảng trên sang sheet Tonghop với.
 

File đính kèm

Mình có một file bao gồm các name vattu_TH, ton_TH, hachtoan_TH tại các sheet khác nhau. Nhờ mọi người trợ giúp code để cóp dữ liệu cả 3 bảng trên sang sheet Tonghop với.
Bạn chạy thử Sub này coi sao:
PHP:
Public Sub sGpe()
Dim Ws As Worksheet, sArr(), dArr(1 To 10000, 1 To 22)
Dim I As Long, J As Long, K As Long, Col As Long, R As Long, Rws As Long
Col = 20
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Tonghop" Then
        With Ws
            Rws = Ws.Range("A10000").End(xlUp).Row
            If Rws > 6 Then
                sArr = Ws.Range("A7:A" & Rws).Resize(, Col).Value
                R = UBound(sArr)
                For I = 1 To R
                    K = K + 1
                    For J = 1 To Col
                        dArr(K, J) = sArr(I, J)
                    Next J
                    dArr(K, 21) = IIf(dArr(K, 20) = Empty, dArr(K, 15), dArr(K, 20))
                    dArr(K, 22) = IIf(dArr(K, 20) = Empty, dArr(K, 11), dArr(K, 19))
                Next I
            End If
        End With
    End If
Next Ws
Sheets("Tonghop").Range("A8").Resize(K, 22) = dArr
End Sub
 
Upvote 0
Cám ơn bạn nhiều nhé, đúng như mình đang cần rồi.
 
Upvote 0
Bạn chạy thử Sub này coi sao:
PHP:
Public Sub sGpe()
Dim Ws As Worksheet, sArr(), dArr(1 To 10000, 1 To 22)
Dim I As Long, J As Long, K As Long, Col As Long, R As Long, Rws As Long
Col = 20
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Tonghop" Then
        With Ws
            Rws = Ws.Range("A10000").End(xlUp).Row
            If Rws > 6 Then
                sArr = Ws.Range("A7:A" & Rws).Resize(, Col).Value
                R = UBound(sArr)
                For I = 1 To R
                    K = K + 1
                    For J = 1 To Col
                        dArr(K, J) = sArr(I, J)
                    Next J
                    dArr(K, 21) = IIf(dArr(K, 20) = Empty, dArr(K, 15), dArr(K, 20))
                    dArr(K, 22) = IIf(dArr(K, 20) = Empty, dArr(K, 11), dArr(K, 19))
                Next I
            End If
        End With
    End If
Next Ws
Sheets("Tonghop").Range("A8").Resize(K, 22) = dArr
End Sub
Cho mình hỏi là với dữ liệu là các bảng trong cùng một sheet thì phải xử lý như nào. Tại dữ liệu là mình cập nhật ở nhiều nơi khác nhau nên mỗi nơi có một mẫu khác nhau
1552362436274.png
 

File đính kèm

Upvote 0
Web KT

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

Back
Top Bottom