Sub GhepChuoiThongTin()
 Dim OutCol As Range, Row As Range, Cl As Range
 Dim Temp As String, Sep As String:                         Dim i As Long
 Const TBao As String = "Thông Báo' "
 
 On Error GoTo Loi
    ' --- Kiem tra workbook --- '
1 If Application.Workbooks.Count = 0 Then Exit Sub  '?? 
    ' --- Kiem tra vung chon ---    '
2 If (Selection Is Nothing) Or (TypeName(Selection) <> "Range") Then
    MsgBox "1 Ban chua chon vùng du liêu cân ghép ô.", vbCritical, TBao
    Exit Sub
 End If
3 If Selection.Areas.Count > 1 Then
    MsgBox "2 Ban da chon nhiêu vùng không liên kê, chi duoc chon 1 vùng duy nhât.", vbExclamation, TBao
    Exit Sub
 End If
    ' --- Nhâp ký tu ngan cách ---      '
4 Sep = InputBox("Nhâp ký tu chèn giua các phân tu duoc ghép:" & vbCrLf & _
    "(Vi du: dâu cách, dâu phay, dâu gach...)", "Tùy chon ký tu", " ")
 If Sep = vbNullString Then Sep = " "
    ' --- Chon cot ket qua ---      '
  On Error Resume Next
5 Set OutCol = Application.InputBox("Chon côt dê ghi kêt qua (chi chon 1 côt):", "Chon côt kêt qua", Type:=8)
 On Error GoTo Loi
6 If OutCol.Columns.Count > 1 Then
    MsgBox "Chi duoc chon 1 côt duy nhât.", vbExclamation, "Thông báo!"
    Exit Sub
 End If
    ' --- Ghep tung hang (theo thu tu, khong phu thuoc vi tri that) --- '
 i = 0
7 For Each Row In Selection.Rows
    Temp = ""
    For Each Cl In Row.Cells
        If Trim(Cl.Text) <> "" Then Temp = Temp & Cl.Text & Sep
    Next Cl
    If Len(Temp) > 0 Then Temp = Left(Temp, Len(Temp) - Len(Sep))
        OutCol.Cells(1, 1).Offset(i, 0).Value = "" & Temp
        i = i + 1
    Next Row
    MsgBox "Da ghép xong du liêu vào côt " & OutCol.Address(False, False) & ".", vbInformation, "Hoàn tât!"
 Exit Sub
Loi:
 MsgBox "Có lôi xây ra trong quá trình ghép ô!", vbCritical, "Dòng Lôi: " & Erl
End Sub