Copy từ nhiều sheet về sheet Tổng hợp (1 người xem)

[Excel365]

Em có sưu tầm được code trên diễn đàn, nay chỉnh sữa lại cho công vệc của mình, nhưng chưa được như ý,
Nhờ các anh chị giúp em sữa làm sao chỉ copy danh sách nhân viên, không các copy các ghi chú, LẬP BIỂU, HỌ TẾN Bên dưới danh sách.
Trân trọng

 

[MuaBuiRoi]

Tại sheet tổng hợp, để tương ứng với sheet khác,

tại A5 bạn gõ: MSCN
tại A6 gõ: 1

tại B5 bạn gõ: HỌ VÀ TÊN
tại B6 gõ: 2

tại C5 bạn gõ: CHỨC VỤ
tại C6 gõ: 3

'''''''''''''
rui thay code mới

Sub Copy_ATM()
    Dim ShName(), arrA(), arrC(), arrF()
    Dim i As Long, StartRow As Long, LastRow As Long
    
    ShName = Array("Luong khoan", "LUONG SP")
    
    Sheets("Tong hop").[A7:g65536].ClearContents
    
    For i = 0 To UBound(ShName)
        With Sheets(ShName(i))
            LastRow = .[A65536].End(xlUp).Row
            arrA = .Range("A7:A" & LastRow).Value
            arrC = .Range("C7:C" & LastRow).Value
            arrF = .Range("F7:F" & LastRow).Value
        End With
        
        With Sheets("Tong hop")
            StartRow = .[A65536].End(xlUp).Row + 1
            .Range("A" & StartRow).Resize(UBound(arrA)) = arrA
            .Range("B" & StartRow).Resize(UBound(arrC)) = arrC
            .Range("C" & StartRow).Resize(UBound(arrF)) = arrF
        End With
    Next i
    
End Sub

Nếu muốn copy cả cột TK thì bạn đọc code làm tương tự,

(đoán code cũ: bạn copy sai cột D , AM , rồi đặt kết quả cũng sai)

 

[MuaBuiRoi]

Nhưng ngắn gọn thì thế này hay hơn

Sub Copy_ATM()
    Application.ScreenUpdating = False
    Dim ShName(), arrA(), arrC(), arrF(), sName, shT As Worksheet
    Dim i As Long, StartRow As Long, nRow As Long
    
    Set shT = Sheets("Tong hop")
    ShName = Array("Luong khoan", "LUONG SP")
    
    shT.[A7:g65536].ClearContents
    For i = 0 To UBound(ShName)
        StartRow = shT.[A65536].End(xlUp).Row + 1
        With Sheets(ShName(i))
            nRow = .[A65536].End(xlUp).Row - 7 + 1
            If nRow > 0 Then
                shT.Range("A" & StartRow).Resize(nRow).Value = .[A7].Resize(nRow).Value
                shT.Range("B" & StartRow).Resize(nRow).Value = .[C7].Resize(nRow).Value
                shT.Range("C" & StartRow).Resize(nRow).Value = .[F7].Resize(nRow).Value
            End If
        End With
    Next i
End Sub

Không dùng bảng phụ arrA, arrC...vv

 

[Excel365]

Nhưng ngắn gọn thì thế này hay hơn

Sub Copy_ATM()
    Application.ScreenUpdating = False
    Dim ShName(), arrA(), arrC(), arrF(), sName, shT As Worksheet
    Dim i As Long, StartRow As Long, nRow As Long
    
    Set shT = Sheets("Tong hop")
    ShName = Array("Luong khoan", "LUONG SP")
    
    shT.[A7:g65536].ClearContents
    For i = 0 To UBound(ShName)
        StartRow = shT.[A65536].End(xlUp).Row + 1
        With Sheets(ShName(i))
            nRow = .[A65536].End(xlUp).Row - 7 + 1
            If nRow > 0 Then
                shT.Range("A" & StartRow).Resize(nRow).Value = .[A7].Resize(nRow).Value
                shT.Range("B" & StartRow).Resize(nRow).Value = .[C7].Resize(nRow).Value
                shT.Range("C" & StartRow).Resize(nRow).Value = .[F7].Resize(nRow).Value
            End If
        End With
    Next i
End Sub

Không dùng bảng phụ arrA, arrC...vv

Nay em muốn sau khi copy nó sẽ dò tìm và điền số Tài khoản từ sheet TK.
Em đã thử đưa hàm Vlookup vô. nhưng không biết làm sao để cho nó hiện kết quả sẽ là giá trị Value. Nếu tìm không có thì sẽ để trống.
Nhờ các anh chị giúp đỡ.
Trân trọng

 

[nghiaphuc]

Nay em muốn sau khi copy nó sẽ dò tìm và điền số Tài khoản từ sheet TK.
Em đã thử đưa hàm Vlookup vô. nhưng không biết làm sao để cho nó hiện kết quả sẽ là giá trị Value. Nếu tìm không có thì sẽ để trống.
Nhờ các anh chị giúp đỡ.
Trân trọng

Trước hết thì bạn phải chuẩn hóa định dạng dữ liệu của bạn cái đã, ai lại để định dạng mặc định là Date bao giờ. Bạn hãy cho chúng về General hết đi.
Sau đó chạy code này sẽ lấy được số tài khoản sang sheet Tổng hợp:
[GPECODE=vb]Sub Copy_TK()
Dim Cll As Range, Sou As Range
On Error Resume Next
For Each Cll In Sheets("Tong hop").[A7:A10000].SpecialCells(2)
Set Sou = Sheets("TK").[A4:A10000].Find(Cll.Text, , , xlWhole)
If Not Sou Is Nothing Then Cll.Offset(, 3) = Sou.Offset(, 2)
Next
End Sub[/GPECODE]
Tôi chỉ tham gia vấn đề lấy số tài khoản, còn việc tổng hợp danh sách thì bạn đã có câu trả lời rồi.

 

[MuaBuiRoi]

Nay em muốn sau khi copy nó sẽ dò tìm và điền số Tài khoản từ sheet TK.
Em đã thử đưa hàm Vlookup vô. nhưng không biết làm sao để cho nó hiện kết quả sẽ là giá trị Value. Nếu tìm không có thì sẽ để trống.
Nhờ các anh chị giúp đỡ.
Trân trọng

Nay em muốn sau khi copy nó sẽ dò tìm và điền số Tài khoản từ sheet TK.
Em đã thử đưa hàm Vlookup vô. nhưng không biết làm sao để cho nó hiện kết quả sẽ là giá trị Value. Nếu tìm không có thì sẽ để trống.
Nhờ các anh chị giúp đỡ.
Trân trọng

Nếu vẫn thích vlookup thì dùng cái này

Sub Copy_ATM()
    Application.ScreenUpdating = False
    Dim ShName(), arrA(), arrC(), arrF(), sName, shT As Worksheet
    Dim i As Long, StartRow As Long, nRow As Long
    
    Set shT = Sheets("Tong hop")
    ShName = Array("Luong khoan", "LUONG SP")
    
    shT.[A7:g65536].ClearContents
    For i = 0 To UBound(ShName)
        StartRow = shT.[A65536].End(xlUp).Row + 1
        With Sheets(ShName(i))
            nRow = .[A65536].End(xlUp).Row - 7 + 1
            If nRow > 0 Then
                shT.Range("A" & StartRow).Resize(nRow).Value = .[A7].Resize(nRow).Value
                shT.Range("B" & StartRow).Resize(nRow).Value = .[C7].Resize(nRow).Value
                shT.Range("C" & StartRow).Resize(nRow).Value = .[F7].Resize(nRow).Value
                
                With shT.Range("D" & StartRow).Resize(nRow)
                    .NumberFormat = "General"  ''(1)
                    .FormulaR1C1 = "=IFERROR("""" & VLOOKUP(RC[-3],TAIKHOAN,3,0),"""")"
                    .Calculate ''(2)
                    .NumberFormat = "@" ''(3)
                    .Value = .Value ''(4)
                End With
            End If
        End With
    Next i
End Sub

Muốn để lại công thức , thì xóa (hoặc đóng ' ) bỏ các 4 dòng ghi chú (1), (2), (3), (4)

 

[Excel365]

Nhưng ngắn gọn thì thế này hay hơn

Sub Copy_ATM()
    Application.ScreenUpdating = False
    Dim ShName(), arrA(), arrC(), arrF(), sName, shT As Worksheet
    Dim i As Long, StartRow As Long, nRow As Long
    
    Set shT = Sheets("Tong hop")
    ShName = Array("Luong khoan", "LUONG SP")
    
    shT.[A7:g65536].ClearContents
    For i = 0 To UBound(ShName)
        StartRow = shT.[A65536].End(xlUp).Row + 1
        With Sheets(ShName(i))
            nRow = .[A65536].End(xlUp).Row - 7 + 1
            If nRow > 0 Then
                shT.Range("A" & StartRow).Resize(nRow).Value = .[A7].Resize(nRow).Value
                shT.Range("B" & StartRow).Resize(nRow).Value = .[C7].Resize(nRow).Value
                shT.Range("C" & StartRow).Resize(nRow).Value = .[F7].Resize(nRow).Value
            End If
        End With
    Next i
End Sub

Không dùng bảng phụ arrA, arrC...vv

Trường hợp em muốn copy dữ liệu ở nhiều cột khác nhau ở mỗi sheet về sheet Tổng hợp có được không ạ, chỉ copy các name được khai báo sẵn.
Ví dụ: Ở sheet Lương khoán em đặt 1 name LK_Tàikhoản và Lượng sản phẩm đạt 1 name LuongSP_Taikhoan.
Do cấu trúc dữ liệu ở mỗi sheet khác nhau nên em không thể thống nhất cột được.
P/s: quên kèm file

 

[Ba Tê]

Trường hợp em muốn copy dữ liệu ở nhiều cột khác nhau ở mỗi sheet về sheet Tổng hợp có được không ạ, chỉ copy các name được khai báo sẵn.
Ví dụ: Ở sheet Lương khoán em đặt 1 name LK_Tàikhoản và Lượng sản phẩm đạt 1 name LuongSP_Taikhoan.
Do cấu trúc dữ liệu ở mỗi sheet khác nhau nên em không thể thống nhất cột được.
P/s: quên kèm file

Xem file có "ăn nhậu" gì với câu hỏi đâu "Chời!"

 

[Excel365]

Xem file có "ăn nhậu" gì với câu hỏi đâu "Chời!"

Em gởi lại file rồi đó anh

 

[Ba Tê]

Em gởi lại file rồi đó anh

1/ Các sheet "luong khoan" và "LUONG SP" tạo 1 dòng phụ ở dòng 4.
Trên dòng này bạn muốn cột nào chuyển về tổng hợp vào cột nào thì ghi số cột ở Tổng hợp vào đó.
2/ Ngoài 3 sheet này ra không còn sheet nào khác (Nếu có thì phải chỉnh code)

 

[Excel365]

1/ Các sheet "luong khoan" và "LUONG SP" tạo 1 dòng phụ ở dòng 4.
Trên dòng này bạn muốn cột nào chuyển về tổng hợp vào cột nào thì ghi số cột ở Tổng hợp vào đó.
2/ Ngoài 3 sheet này ra không còn sheet nào khác (Nếu có thì phải chỉnh code)

Vậy trường hợp em muốn thêm nhiều sheet nữa thì chỉnh code như thế nào hả anh

 

[Excel365]

1/ Các sheet "luong khoan" và "LUONG SP" tạo 1 dòng phụ ở dòng 4.
Trên dòng này bạn muốn cột nào chuyển về tổng hợp vào cột nào thì ghi số cột ở Tổng hợp vào đó.
2/ Ngoài 3 sheet này ra không còn sheet nào khác (Nếu có thì phải chỉnh code)

Em có đưa code của anh vô file dữ liệu của em, nhưng khi tổng hợp thì nó lại ra kết quả không đúng.
Các sheet màu đỏ là những sheet em cần tổng hợp vô sheet DS_ATM.
Các cột cần tổng hợp bao gồm (Những cột em tô màu)
1- Họ và tên
2- Ghi chú
3- Chức danh
4- Tiền lương còn lại
5- Tài khoản Viẹtcombank
6-Tài khoản BIDV
7- MSNV (Mã số nhân viên)
Em gởi file lên nhờ anh chỉnh code lại dùm em.
Trân trọng cám ơn!

http://www.mediafire.com/download/69lbea5nlklfd08/09-2014.rar

 

[Ba Tê]

Em có đưa code của anh vô file dữ liệu của em, nhưng khi tổng hợp thì nó lại ra kết quả không đúng.
Các sheet màu đỏ là những sheet em cần tổng hợp vô sheet DS_ATM.
Các cột cần tổng hợp bao gồm (Những cột em tô màu)
1- Họ và tên
2- Ghi chú
3- Chức danh
4- Tiền lương còn lại
5- Tài khoản Viẹtcombank
6-Tài khoản BIDV
7- MSNV (Mã số nhân viên)
Em gởi file lên nhờ anh chỉnh code lại dùm em.
Trân trọng cám ơn!

http://www.mediafire.com/download/69lbea5nlklfd08/09-2014.rar

Nhìn File của bạn mà "ướt mồ hôi".
Cả trăm sheet, mỗi sheet hàng trăm cột, các ô hầu như đều là công thức, máy nào chạy nỗi cũng phải mạnh lắm đây.
Máy tôi thì chạy không nỗi.
Tôi Xoá chỉ chừa lại 3 sheet mẫu và 1 sheet DS-ATM, bạn tải file về xem và làm theo các yêu cầu sau:
1/ Chép Sub Tonghop trong Mudule GPE_B vào file thật của bạn.
2/ Trong sheet DS-ATM tôi chèn thêm 1 cột A, Bạn nhập đúng tên các sheet cần lấy dữ liệu về sheet DS-ATM vào từ A11 liên tục xuống (Tôi đã nhập mẫu tên của 3 sheet), Nhập xong hide cột A đi.
3/ Tất cả các sheet muốn lấy dữ liệu:
- Dòng 6 nhập số cột khi lấy về sheet DS-ATM, như tôi đã nhập và tô màu vàng.
- Dòng bắt đầu lấy dữ liệu phải là dòng 11, không thể sheet này dòng 10, sheet kia 11, sheet nọ 12.
4/ Hiện kết quả ở cột I sheet DS-ATM đều ra giá trị là #Value! là do công thức cuả các cột "Tiền lương còn lại" trong các sheet bị lỗi vì tôi xoá các sheet và 950 Name rác. Bạn chạy trên File thật của bạn "hy vọng" sẽ không bị lỗi này.
File bị "quay quay" vì dung lượng file của bạn (chứa công thức nhiều quá), chịu khó "uống vài ly Cà phê" chờ khi code chạy xong nhé.
Tôi không đủ can đảm gởi file hơn 5MB của bạn lên đây nên phải cắt bớt.

 

[Excel365]

Nhìn File của bạn mà "ướt mồ hôi".
Cả trăm sheet, mỗi sheet hàng trăm cột, các ô hầu như đều là công thức, máy nào chạy nỗi cũng phải mạnh lắm đây.
Máy tôi thì chạy không nỗi.
Tôi Xoá chỉ chừa lại 3 sheet mẫu và 1 sheet DS-ATM, bạn tải file về xem và làm theo các yêu cầu sau:
1/ Chép Sub Tonghop trong Mudule GPE_B vào file thật của bạn.
2/ Trong sheet DS-ATM tôi chèn thêm 1 cột A, Bạn nhập đúng tên các sheet cần lấy dữ liệu về sheet DS-ATM vào từ A11 liên tục xuống (Tôi đã nhập mẫu tên của 3 sheet), Nhập xong hide cột A đi.
3/ Tất cả các sheet muốn lấy dữ liệu:
- Dòng 6 nhập số cột khi lấy về sheet DS-ATM, như tôi đã nhập và tô màu vàng.
- Dòng bắt đầu lấy dữ liệu phải là dòng 11, không thể sheet này dòng 10, sheet kia 11, sheet nọ 12.
4/ Hiện kết quả ở cột I sheet DS-ATM đều ra giá trị là #Value! là do công thức cuả các cột "Tiền lương còn lại" trong các sheet bị lỗi vì tôi xoá các sheet và 950 Name rác. Bạn chạy trên File thật của bạn "hy vọng" sẽ không bị lỗi này.
File bị "quay quay" vì dung lượng file của bạn (chứa công thức nhiều quá), chịu khó "uống vài ly Cà phê" chờ khi code chạy xong nhé.
Tôi không đủ can đảm gởi file hơn 5MB của bạn lên đây nên phải cắt bớt.

Em cảm ơn anh. chú anh nhiều sức khỏe
Để em xem thử. có gì nhờ anh hỗ trỡ sau.

 

[Excel365]

Nhìn File của bạn mà "ướt mồ hôi".
Cả trăm sheet, mỗi sheet hàng trăm cột, các ô hầu như đều là công thức, máy nào chạy nỗi cũng phải mạnh lắm đây.
Máy tôi thì chạy không nỗi.
Tôi Xoá chỉ chừa lại 3 sheet mẫu và 1 sheet DS-ATM, bạn tải file về xem và làm theo các yêu cầu sau:
1/ Chép Sub Tonghop trong Mudule GPE_B vào file thật của bạn.
2/ Trong sheet DS-ATM tôi chèn thêm 1 cột A, Bạn nhập đúng tên các sheet cần lấy dữ liệu về sheet DS-ATM vào từ A11 liên tục xuống (Tôi đã nhập mẫu tên của 3 sheet), Nhập xong hide cột A đi.
3/ Tất cả các sheet muốn lấy dữ liệu:
- Dòng 6 nhập số cột khi lấy về sheet DS-ATM, như tôi đã nhập và tô màu vàng.
- Dòng bắt đầu lấy dữ liệu phải là dòng 11, không thể sheet này dòng 10, sheet kia 11, sheet nọ 12.
4/ Hiện kết quả ở cột I sheet DS-ATM đều ra giá trị là #Value! là do công thức cuả các cột "Tiền lương còn lại" trong các sheet bị lỗi vì tôi xoá các sheet và 950 Name rác. Bạn chạy trên File thật của bạn "hy vọng" sẽ không bị lỗi này.
File bị "quay quay" vì dung lượng file của bạn (chứa công thức nhiều quá), chịu khó "uống vài ly Cà phê" chờ khi code chạy xong nhé.
Tôi không đủ can đảm gởi file hơn 5MB của bạn lên đây nên phải cắt bớt.

[GPECODE=VB]Option ExplicitPublic Sub TongHop()
Dim sArr(), tArr(), Ds(), I As Long, J As Long, K As Long, N As Long, CoL As Long, R As Long
Dim Cll As Range, dArr(1 To 10000, 1 To 8), STT As Long
Application.ScreenUpdating = False
Ds = Sheets("DS-ATM").Range("A11:A" & Sheets("DS-ATM").Range("A11").End(xlDown).Row).Value
For N = 1 To UBound(Ds, 1)
With Worksheets(Ds(N, 1))
CoL = .[XFD6].End(xlToLeft).Column
R = .[C11].End(xlDown).Row - 5
sArr = .[A6].Resize(R, CoL).Value
For I = 6 To R '4
K = K + 1
For J = 1 To CoL
If sArr(1, J) <> Empty Then
dArr(K, sArr(1, J)) = sArr(I, J)
End If
Next J
Next I
End With
Next N
With Sheets("DS-ATM")
.[B11:I1000].ClearContents
.[B11:I1000].Font.Bold = False
.[B11:I1000].Borders.LineStyle = 0
.[B11].Resize(K, 8) = dArr
.[B11].Resize(K, 8).Borders.LineStyle = 1
.[D11].Resize(K).Font.Bold = False
For Each Cll In .Range(.[D11], .[D11].End(xlDown))
If Cll.Offset(, -2) = Empty Then
Cll.Resize(, 6).Font.Bold = True
Else
STT = STT + 1: Cll.Offset(, -1) = STT
End If
Next Cll
End With
Application.ScreenUpdating = True
End Sub


[/GPECODE]

Hiện tại thì code tổng hợp dữ liệu từ các Sheet về Sheet DS-ATM. Nếu em muốn Tổng các Sheet lại sang 1 file mới có định dạng theo như mẩu DS-ATM thì chỉnh code lại như thế nào vậy anh

Trân trọng cảm ơn!

 

[Excel365]

Bạn đã có code. Tổng hợp lại trên 1 sheet. Giờ muốn ra file mới...thì tại sao không biết tự copy cái sheet này thành file mới...Chỉ là Move or Copy thôi mà...thế là bạn đã có 1 file mới với sheet Tổng Hợp rồi...
Muốn macro thì chỉ cần ghi macro (record) quá trình trên là bạn đã có code cho mình rồi...

Đâu cần si nghĩ gì cho xa xôi vậy bạn???

Do file của em có dung lượng lớn, em muốn tách sheet đó ra để giảm dung lượng file, cải thiện tốc độ.
Em cũng thử Record Macro nhưng không biết kết hợp vô code tổng hợp đã có.
Trân trọng