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
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") )
Cảm ơn anh @VetMini đã giải thích
Anh cho mình một phương án tốt nhất để dễ làm và dễ hiểu được không?
Thật sự mình đọc trên diễn đàn chắc chắn là bạn nhiều tuổi hơn mình.
Nhưng điều đó không quan trọng lắm
Anh @VetMini có thể viết code ngán gọn hơn được không?
à quên anh @SA_DQ nữa
 
Upvote 0
1 cách ngắn gọn hơn chỉ có ý nghĩa thẩm mỹ thôi nha:
Tách macro đó làm 2: Cha & con;
Cha truền cho con các tham biến cần thiết về Dòng, Cột & Vùng ô
Bạn thử tìm hiểu chuyện đó coi xem sao(?!)
 
Upvote 0
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") )
Lại phải phiền anh @VetMini chỉnh giúp
Mình sửa như này thì nó sai ở đâu vậy anh @VetMini giúp mình với
Cảm ơn anh.
Mã:
Sub CopyFrom3Sheets_2()
 Dim Dong As Long
 Dim Cot1 As Integer, Cot2 As Integer, Cot3 As Integer
 Dim Sh As Worksheet, Rng As Range
 'Set Sh = Array(Worksheets("1"), Worksheets("2"), Worksheets("3"))

 'On Error Resume Next
With Sheets("THop")
    '[A3:Z49].EntireRow.Delete
    Cot1 = 2
    Cot2 = 2
    Cot3 = 2
    'For Each Sh In ThisWorkbook.Worksheets
    For Each Sh In Array(Worksheets("1"), Worksheets("2"), Worksheets("3"))

        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
Lại phải phiền anh @VetMini chỉnh giúp
Mình sửa như này thì nó sai ở đâu vậy anh @VetMini giúp mình với
Cảm ơn anh.
Mã:
Sub CopyFrom3Sheets_2()
Dim Dong As Long
Dim Cot1 As Integer, Cot2 As Integer, Cot3 As Integer
Dim Sh As Worksheet, Rng As Range
'Set Sh = Array(Worksheets("1"), Worksheets("2"), Worksheets("3"))

'On Error Resume Next
With Sheets("THop")
    '[A3:Z49].EntireRow.Delete
    Cot1 = 2
    Cot2 = 2
    Cot3 = 2
    'For Each Sh In ThisWorkbook.Worksheets
    For Each Sh In Array(Worksheets("1"), Worksheets("2"), Worksheets("3"))

        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
Anh @VetMini sửa giúp mình tại sao nó lại không chạy nhỉ.
Sau khi đã sửa một chút síu theo chỉ dẫn của anh
Thế mà nó lại không chạy?
 
Upvote 0
Web KT
Back
Top Bottom