Tạo macro gộp tiêu đề của nhiều cell lại thành 1cell

[timhieu02]

Em nhờ các anh chị làm dùm em 1 macro để gộp các tiêu đề bị nhảy qua cell khác.em gửi file đính kèm trước khi gộp lai và 1 file đính kèm sau khi đã gộp.giúp dùm em.

 

[huuthang_bd]

Xem dữ liệu của bạn tôi tưởng là dữ liệu được xuất từ phần mềm và sẽ đồng nhất chứ.

Sub EditHeader()
Application.ScreenUpdating = False
Dim FirstCllAdd As String, FirstCll As Range, LastCll As Range, ACll As Range, Check As Boolean, Str As String
Set ACll = [A1]
FirstCllAdd = Cells.Find("~*---", ACll, xlFormulas, xlPart, xlByRows, xlNext).Address
Do
    Set FirstCll = Cells.FindNext(After:=ACll)
    Set ACll = FirstCll
    Set LastCll = FirstCll
    Str = ""
    If FirstCll.Address = FirstCllAdd Then Check = Not Check
    Do
        Str = Str & LastCll.Offset(-1).Value
        If Right(LastCll.Value, 4) = "---*" Or InStr(LastCll.Value, "---") = 0 Then Exit Do
        Set LastCll = LastCll.Offset(, 1)
    Loop
    With Range(FirstCll, LastCll).Offset(-1)
        .ClearContents
        .Merge
        .HorizontalAlignment = xlCenter
    End With
    FirstCll.Offset(-1).Value = Str
Loop Until Not Check And FirstCll.Address = FirstCllAdd
Application.ScreenUpdating = True
End Sub