BỎ MERCE CELL VỚI SỐ LƯỢNG LỚN (2 người xem)

[mylinh22031]

hi anh chị,
Em có một bảng dữ liệu khi xuất từ phần mềm bị lỗi merge ô, không lọc dữ liệu được
Anh chị có cách nào bỏ merge ô nhanh mà không bị mất dữ liệu thay vì làm thủ công coppy paste không ạ
Em cảm ơn anh chị

 

[snow25]

hi anh chị,
Em có một bảng dữ liệu khi xuất từ phần mềm bị lỗi merge ô, không lọc dữ liệu được
Anh chị có cách nào bỏ merge ô nhanh mà không bị mất dữ liệu thay vì làm thủ công coppy paste không ạ
Em cảm ơn anh chị

Cho cái dữ liệu sau khi bạn làm copy paste nào.

 

[mylinh22031]

Cho cái dữ liệu sau khi bạn làm copy paste nào.

em gửi lại file nha

 

[mylinh22031]

không ai giúp em hết ạ, hichic

 

[snow25]

em gửi lại file nha

Bạn chạy code này nhé.Và tự chỉnh lại tiêu đề.

Sub laydulieu()
    Dim arr, kq, lr As Long, a As Long, b As Long, so(1 To 100), i As Long, j As Long
    With Sheets("trc khi sua")
         lr = .Range("R" & Rows.Count).End(xlUp).Row
         arr = .Range("B15:AY" & lr).Value
         For i = 1 To UBound(arr, 2)
             If Len(arr(1, i)) > 0 Then
                b = b + 1
                so(b) = i
             End If
         Next i
         ReDim kq(1 To UBound(arr), 1 To b)
         For i = 1 To UBound(arr, 1)
             If Len(arr(i, 17)) > 0 Then
                a = a + 1
                For j = 1 To b
                    kq(a, j) = arr(i, so(j))
                Next j
             End If
        Next i
    End With
    With Sheets("sau khi sua")
         lr = .Range("G" & Rows.Count).End(xlUp).Row
         If lr > 1 Then .Range("A2:P" & lr).ClearContents
         If a Then .Range("A2").Resize(a, b).Value = kq
    End With
End Sub