Tổng hợp nhiều sheet vào một sheet (3 người xem)

  • Thread starter Thread starter nvh611
  • Ngày gửi Ngày gửi
Liên hệ QC

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

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

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

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
...Nhưng code của anh đang bị sai cái gì đó.
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.
 
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

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

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

Back
Top Bottom