Ghép nối dữ liệu nhiều cột không liên tiếp

[manhvlance]

Gửi các bạn!

Mình bị phát sinh vấn đề khi kiểm tra lại bài toán của mình. Vì trong các dòng dữ liệu của mình sẽ có dòng trắng nên nếu sử dụng code của bạn Let'GâuGâu mình chưa giải quyết được bài toán của mình. Vậy nhờ các bạn sửa code đó hỗ trợ thêm giúp mình nhé. Thanks!

thử cách cù bắp...hihihihih

Giả sử dữ liệu vùng 1 la sheet1, vùng 2 là sheet 2, ... thì xử lý như thế nào để giống như yêu cầu trên vậy anh Let'gâugâu?

thêm một cái cù bắp nữa nè..............hehehehe

Sub ghepcot()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
    If ws.Name <> "sheet tong hop" Then
        With ws
            lr = .[c60000].End(3).Row - 3
            [a60000].End(3).Offset(1).Resize(lr, 3).Value = .[a4].Resize(lr, 3).Value
        End With
    End If
Next

Application.ScreenUpdating = True
    
End Sub

nhớ tạo tiêu đề cho sheet tong hop nha

[thanhbinh0824h]

....

Sau khi ghép cột xong, để xóa dòng trống bác có thể thêm thủ tục xóa (đỡ phải chỉnh code cũ):

Columns("O").Insert
Range("O4").Formula="=COUNTA(RC[-3]:RC[-1])=0"
Range("O4:O1000").Filldown
Range("L4:O1000").Sort Range("O4")
Columns("O").Delete

Công thức cột O trả về TRUE nếu dòng trống, sort để chuyển dòng trống xuống dưới cùng là xong.

[nguyen.duong2402]

Gửi: Bạn Let'GâuGâu & Hau151978!
Mình đã chạy code 2 bạn giúp mình. Thật đúng với ý mong muốn của mình. Cảm ơn 2 bạn và các bạn trên diễn đàn đã giúp đỡ mình nhiệt tình. Thanks!

[lucbeo]

Gửi: Bạn Let'GâuGâu

Hiện tại mình còn 1 file số lượng các cột nhiều hơn 3, số vùng cần nối cũng nhiều hơn 3. Mình đã sửa code như file bạn gửi, tuy nhiên vẫn chưa chạy đúng theo mong muốn. Vậy nhờ bạn sửa code giúp mình nhé. Code mình đã đưa vào file. Thanks bạn!

[zphot9x]

Gửi: Các bạn!

Nội dung trong file ghepcot V02, anhdottk đang cần, nhờ các pro xem giúp nhé. Thanks!

[BavnPro]

Gửi: Các bạn!

Nội dung trong file ghepcot V02, anhdottk đang cần, nhờ các pro xem giúp nhé. Thanks!

Nếu bạn chịu đọc đường link ở bài 8 thì đã tự làm được mà không phải hỏi lòng vòng rồi
Với code đó, để áp dụng bạn chỉ cần viết thêm 1 sub thế này:

Sub Main()
  Dim aRes
  Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range, r8 As Range
  Set r1 = Sheets("TH").Range("A4:N1000")
  Set r2 = r1.Offset(, 14)
  Set r3 = r2.Offset(, 14)
  Set r4 = r3.Offset(, 14)
  Set r5 = r4.Offset(, 14)
  Set r6 = r5.Offset(, 14)
  Set r7 = r6.Offset(, 14)
  Set r8 = r7.Offset(, 14)
  aRes = Join2DArray(r1, r2, r3, r4, r5, r6, r7, r8)
  Sheets("TH").Range("DM4:DZ4").Resize(UBound(aRes, 1)).Value = aRes
End Sub

Hoặc cách khác:

Sub Main()
  Dim aRes, rng As Range, n As Long
  For n = 1 To 8
    Set rng = Sheets("TH").Range("A4:N1000").Offset(, (n - 1) * 14)
    If Not IsArray(aRes) Then
      aRes = Join2DArray(rng)
    Else
      aRes = Join2DArray(aRes, rng)
    End If
  Next
  Sheets("TH").Range("DM4:DZ4").Resize(UBound(aRes, 1)).Value = aRes
End Sub

Chỉ cần biết áp dụng (như chỗ tô đỏ), mấy code khác không cần quan tâm
----------------------
Ghi chú: Hàm Join2DArray dùng để nối nhiều vùng dữ liệu lại với nhau (bao nhiêu vùng thì cứ liệt kê vào trong hàm)

[viettopcare1]

Gửi bạn ndu96081631 !

Cảm ơn bạn đã giải quyết nội dung này giúp mình. Thanks bạn!