Tổng hợp nhiều sheet vào một sheet

Liên hệ QC

nvh611

Thành viên thường trực
Tham gia
20/5/17
Bài viết
228
Được thích
42
Chào các bạn
Nhờ các bạn giúp đỡ như file đính kèm
Trân thành cảm ơn các bạn!
 

File đính kèm

  • Tổng hợp các sheet vào 1 sheet.xlsb
    17.6 KB · Đọc: 3
Có nghĩa là các trang tính '1', '2' & '3' đều có 3 vùng dữ liệu (Mà chúng đều giống hệt nhau là sao?)
Nhiệm vụ là chuyển 2 vùng dưới của các trang tính này sang cột 'B' của trang tổng hợp, với iêu cầu cách vùng 1 (tại trang tổng hợp 2 dòng)

Thắc mắc 1 điều là các vùng số liệu của các trang kia giống nhau hết thì việc gì phải làm cho 3 lần tổng hợp, chỉ cần 1 lần thôi; Nhưng nếu bạn lười trong giả lập file thì chào bạn, mình đi chỗ khác đây!
 
Upvote 0
Tự làm lấy thì chỉ trong vòng 30 phút.
Cái file có chút xíu vậy cũng gửi lên đây nhờ người ta làm giùm.
 
Upvote 0
Vấn đề là 'người ta' muốn làm cũng không biết thế nào cho thỏa mong mõi của chủ bài đăng.
 
Upvote 0
Ủa rồi tổng hợp từ 3 sheet '1,'2,'3 rồi mà sheet Tonghop số liệu y chang 3 cái kia thì đâu phải tổng hợp
 
Upvote 0

File đính kèm

  • Tổng hợp các sheet vào 1 sheet.xlsb
    17.6 KB · Đọc: 21
Upvote 0
Bạn thử chạy macro này:
PHP:
Sub CopyFrom3Sheet()
 Dim Dong As Long, Cot As Integer
 Dim Sh As Worksheet, Rng As Range
 On Error Resume Next
With Sheets("THop")
    [A3:Z49].ClearContents
    For Each Sh In ThisWorkbook.Worksheets
        Dong = 3
        If IsNumeric(Sh.Name) Then
            Cot = Choose(CInt(Sh.Name), 2, 8, 14, 35)
            
            Set Rng = Sh.[b3].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot)
            
            Dong = Dong + Rng.Rows.Count + 2
            Set Rng = Sh.[G16].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot)
            
            Dong = Dong + 2 + Rng.Rows.Count
            Set Rng = Sh.[e31].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot)
        End If
    Next Sh
End With
End Sub
 
Upvote 0
Bạn thử chạy macro này:
PHP:
Sub CopyFrom3Sheet()
Dim Dong As Long, Cot As Integer
Dim Sh As Worksheet, Rng As Range
On Error Resume Next
With Sheets("THop")
    [A3:Z49].ClearContents
    For Each Sh In ThisWorkbook.Worksheets
        Dong = 3
        If IsNumeric(Sh.Name) Then
            Cot = Choose(CInt(Sh.Name), 2, 8, 14, 35)
           
            Set Rng = Sh.[b3].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot)
           
            Dong = Dong + Rng.Rows.Count + 2
            Set Rng = Sh.[G16].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot)
           
            Dong = Dong + 2 + Rng.Rows.Count
            Set Rng = Sh.[e31].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot)
        End If
    Next Sh
End With
End Sub
Cảm ơn anh @SA_DQ
Nhưng mình chạy không ra kết quả
Anh kiểm tra giúp xem sai sót ở đâu hộ mình với nhé.
Anh có thể viết chọn từng vùng được không?
Cảm ơn anh nhá.
 
Upvote 0
Thế nào là không ra kết quả:
Không chạy macro?
Không tổng hợp tẹo dữ liệu nào; Trang THop trống trơn?
Chỉ tổng hợp đúng trang '1'?
. . . . (gì khác?)
 
Upvote 0
1: Hãy đổi tên trang tính 'TongHop' thành 'THop' như trong macro hay ngược lại
2: Nếu vẫn kết quả cũ thì vô hiệu hóa dòng lệnh On Error Resume Next & bạn sẽ biết lỗi do đâu ở chương trình.
 
Upvote 0
1: Hãy đổi tên trang tính 'TongHop' thành 'THop' như trong macro hay ngược lại
2: Nếu vẫn kết quả cũ thì vô hiệu hóa dòng lệnh On Error Resume Next & bạn sẽ biết lỗi do đâu ở chương trình.
Cảm ơn anh @SA_DQ rất nhiều
Mình đã đổi tên Sheet và code đã chạy
Nhưng có một điều là kết quả không được như mong muốn.
Phiền anh @SA_DQ giúp mình sửa lại với nhá
và một điều này nừa mong anh @SA_DQ thông cảm (Mình kém về môn này)
===>>> Vì vậy anh @SA_DQ có thể nghiên cứu xem là chọn từng vùng dữ liệu được không?
Bời vì dữ liệu của mình xếp lung tung loạn xạ
Trân thành cảm ơn anh @SA_DQ
 

File đính kèm

  • Tổng hợp các sheet vào 1 sheet.xlsb
    25.1 KB · Đọc: 5
Upvote 0
Mình vừa chép macro bài trên đưa vô file bài 13 & cho chạy ra kết quả bình thường mà?
Hay chưa đạt iêu cầu của bạn ở chổ nào vậy; Bạn cần mô tả kỹ để chúng ta sửa cho đạt;
Còn vụ chép vùng thì macro nó làm được rồi mà: Qua mỗi trang tính (mang số) nó chép lần lượt từng vùng từ trên xuống dưới đó thây.
???
 
Upvote 0
Mình vừa chép macro bài trên đưa vô file bài 13 & cho chạy ra kết quả bình thường mà?
Hay chưa đạt iêu cầu của bạn ở chổ nào vậy; Bạn cần mô tả kỹ để chúng ta sửa cho đạt;
Còn vụ chép vùng thì macro nó làm được rồi mà: Qua mỗi trang tính (mang số) nó chép lần lượt từng vùng từ trên xuống dưới đó thây.
???
Báo cáo anh @SA_DQ kết quả mong muốn của mình là như này



Kết quả mong muốn.
* Cột đầu tiên cùng nằm trên cột "B"
* Các vùng cách nhau 2 dòng
* Và các vùng của các sheet cách nhau 3 cột
Cảm ơn các bạn
Nhưng code của anh đang bị sai cái gì đó.
Anh @SA_DQ viết dùm code khác để cho mình đễ hiểu và làm thực tế với
Cảm ơn anh @SA_DQ đã quan tâm và giúp đỡ.
 
Upvote 0
Sai ra làm sao thì chỉ mình bạn biết, sao lại nói "cái gì đó".

Code chạy ra kết quả A, nếu đúng thì phải là B.
Giải thích A và B khác nhau thế nào thì người ta mới biết.
Báo cáo anh @VetMini theo như kết quả mong muốn của mình thì như này:


Kết quả mong muốn.
* Cột đầu tiên cùng nằm trên cột "B"
* Các vùng cách nhau 2 dòng
* Và các vùng của các sheet cách nhau 3 cột
Nhưng code của anh @SA_DQ chỉ đúng ý 1
Anh xem giùm nhá
 

File đính kèm

  • Tổng hợp các sheet vào 1 sheet.xlsb
    25.2 KB · Đọc: 7
Upvote 0
Sửa code trên như sau:

Mã:
Sub CopyFrom3Sheets()
 Dim Dong As Long
 Dim Cot1 As Integer, Cot2 As Integer, Cot3 As Integer
 Dim Sh As Worksheet, Rng As Range
 'On Error Resume Next
With Sheets("THop")
    [A3:Z49].EntireRow.Delete
    Cot1 = 2
    Cot2 = 2
    Cot3 = 2
    For Each Sh In ThisWorkbook.Worksheets
        Dong = 3
        If IsNumeric(Sh.Name) Then
            'Cot = Choose(CInt(Sh.Name), 2, 8, 14, 35)
            
            Set Rng = Sh.[b3].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot1)
            Cot1 = Cot1 + Rng.Columns.Count + 3
            
            Dong = Dong + Rng.Rows.Count + 2
            Set Rng = Sh.[G16].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot2)
            Cot2 = Cot2 + Rng.Columns.Count + 3
            
            Dong = Dong + 2 + Rng.Rows.Count
            Set Rng = Sh.[e31].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot3)
            Cot3 = Cot3 + Rng.Columns.Count + 3
        End If
    Next Sh
End With
End Sub
 
Upvote 0
Sửa code trên như sau:

Mã:
Sub CopyFrom3Sheets()
Dim Dong As Long
Dim Cot1 As Integer, Cot2 As Integer, Cot3 As Integer
Dim Sh As Worksheet, Rng As Range
'On Error Resume Next
With Sheets("THop")
    [A3:Z49].EntireRow.Delete
    Cot1 = 2
    Cot2 = 2
    Cot3 = 2
    For Each Sh In ThisWorkbook.Worksheets
        Dong = 3
        If IsNumeric(Sh.Name) Then
            'Cot = Choose(CInt(Sh.Name), 2, 8, 14, 35)
           
            Set Rng = Sh.[b3].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot1)
            Cot1 = Cot1 + Rng.Columns.Count + 3
           
            Dong = Dong + Rng.Rows.Count + 2
            Set Rng = Sh.[G16].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot2)
            Cot2 = Cot2 + Rng.Columns.Count + 3
           
            Dong = Dong + 2 + Rng.Rows.Count
            Set Rng = Sh.[e31].CurrentRegion
            Rng.Copy Destination:=.Cells(Dong, Cot3)
            Cot3 = Cot3 + Rng.Columns.Count + 3
        End If
    Next Sh
End With
End Sub
Cảm ơn anh @VetMini và anh @SA_DQ đã nhiết tình giúp đỡ, bài đã rất chuẩn
anh @VetMini cho mình hỏi cái dòng lệnh bên dưới có phải là (Nếu sheet nào có tên là chữ số thì nó mới tổng hợp phải không 2 anh?)
If IsNumeric(Sh.Name) Then
 
Upvote 0
...anh @VetMini cho mình hỏi cái dòng lệnh bên dưới có phải là (Nếu sheet nào có tên là chữ số thì nó mới tổng hợp phải không 2 anh?)
If IsNumeric(Sh.Name) Then
Bởi vì bạn đặt tên sheet là 1, 2, 3 cho nên bài kia mới làm vậy.
Bình thường thì người ta đặt một array sheets
Forv Each Sh In Array(WorkSheets("tên sheet 1"), WorkSheets("tên sheet 2"), WorkSheets("tên sheet 3", ...) )
Tức là trong trường hợp bài này:
Forv Each Sh In Array(WorkSheets("1"), WorkSheets("2"), WorkSheets("3") )
 
Upvote 0
Web KT
Back
Top Bottom