多个单元格合并到一个单元格中

jeckey_an

在做一个简历合并的汇总表。想把多条经历合并到一个单元格中。
Sub SUMWA()
If Dir(ThisWorkbook.Path & "\*.xlsx") = "" Then Exit Sub
Dim r As Range, m As String, c As Integer, fb As String, rc As Integer, i As Integer
Dim f, st, dt, et, tt, yt, ddt, sst

rc = CreateObject("scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count
'Cells(5, 1).CurrentRegion.Offset(3, 0).ClearContents
Application.ScreenUpdating = False
st = Timer
fb = ActiveWorkbook.Name
loadingbar.Show 0
rc = CreateObject("scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count
For Each f In CreateObject("scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files

'================================================================这些都是没用的
i = i + 1
yt = rc * (Timer - st) / i - (Timer - st)

tt = Format(yt \ 3600, "00") & ":" & Format((yt Mod 3600) \ 60, "00") & ":" & Format(yt Mod 60, "00") & "." & Format(yt * 100 Mod 100, "00")

sx = " 已完成 " & i & "  进行到: " & i & "/" & rc & "    请稍候!..." ' & tt
sy = VBA.Int(i / rc * 366)

    With loadingbar
        .ProgressBar1.Width = sy
        .Label1.Caption = tt
        .Caption = sx
        .Repaint
    End With
'===================================================================这些都是没用的
m = Replace(Dir(f), "简历.xlsx", "")
Set r = Range("b5", Cells(Rows.Count, 2).End(3)).Find(m, , , 1)
If r Is Nothing And f.Name <> fb Then
c = Cells(Rows.Count, 2).End(3).Row + 1
'If f.Name Like "*.xlsx" And f.Name <> "人力资源汇总.xlsx" Then

Workbooks.Open Filename:=f

With Workbooks(fb).Sheets(1)
.Cells(c, 1) = c - 4 '序号
.Cells(c, 2) = m 'XXX的简历
'If Application.WorksheetFunction.IsNumber(Cells(17, 6) * 1) = True And Len(Cells(17, 6)) = 18 Then
'.Cells(c, 3) = Cells(17, 6) '身份证=F17
'.Cells(c, 4) = Year(Date) - Mid$(Cells(17, 6), 7, 4) ' Mid(F17, 7, 4) '年龄
'.Cells(c, 5) = IIf(Val(Mid(Cells(17, 6), 15, 3)) Mod 2 = 1, "男", "女")
'.Cells(c, 6) = Mid(Cells(17, 6), 7, 4) & "-" & Mid(Cells(17, 6), 11, 2)
'.Cells(c, 7) = Mid(Cells(17, 6), 11, 2) & "月" & Mid(Cells(17, 6), 13, 2) & "日"
'End If
.Cells(c, 1) = c - 4 '序号
.Cells(c, 4) = Cells(2, 2) '姓名
.Cells(c, 5) = Cells(2, 6) '工号
.Cells(c, 6) = Cells(2, 11) '出生年月
.Cells(c, 7) = Cells(3, 2) '性别
.Cells(c, 8) = Cells(3, 6) '民族
.Cells(c, 9) = Cells(3, 11) '政治面貌
.Cells(c, 10) = Cells(4, 2) '籍贯
.Cells(c, 11) = Cells(4, 6) '出生地
.Cells(c, 12) = Cells(4, 11) '入党时间
.Cells(c, 13) = Cells(5, 2) '毕业时间
.Cells(c, 14) = Cells(5, 6) '进入公司时间
.Cells(c, 15) = Cells(5, 11) '手机号码
.Cells(c, 16) = Cells(6, 2) '身份证号码
.Cells(c, 17) = Cells(6, 9) '户籍所在地
.Cells(c, 18) = Cells(6, 14) '最高学历(3, 20).Text
.Cells(c, 19) = Cells(7, 2) '现居住地址
.Cells(c, 20) = Cells(7, 14) '邮政编码
.Cells(c, 21) = Cells(8, 2) '紧急联系人
.Cells(c, 22) = Cells(8, 6) '与本人关系
.Cells(c, 23) = Cells(8, 11) '紧急联系人电话号码
.Cells(c, 24) = Cells(9, 2) '职业资格证书名称
.Cells(c, 25) = Cells(9, 11) '取证时间
.Cells(c, 26) = Cells(10, 2) '职称等级、专业
.Cells(c, 27) = Cells(10, 11) '评审时间
.Cells(c, 28) = Cells(11, 2) '适任证书
.Cells(c, 29) = Cells(11, 9) '发证时间
.Cells(c, 30) = Cells(11, 14) '外语语种、等级
.Cells(c, 31) = Cells(12, 2) '任职部门
.Cells(c, 32) = Cells(12, 6) '任职岗位
.Cells(c, 33) = Cells(12, 11) '任职时间
.Cells(c, 34) = Cells(13, 2) '本人优势
.Cells(c, 35) = Cells(14, 2) '本人不足
.Cells(c, 36) = Cells(13, 11) '职业目标 (或希望发展方向)
.Cells(c, 37) =                        '学历
ActiveWorkbook.Close savechanges = False
End With
End If

If Not r Is Nothing And f.Name <> fb Then
Workbooks.Open Filename:=f
With Workbooks(fb).Sheets(1)
If Application.WorksheetFunction.IsNumber(Cells(17, 6) * 1) = True And Len(Cells(17, 6)) = 18 Then
r(1, 2) = Cells(17, 6) '身份证=F17
r(1, 3) = Year(Date) - Mid$(Cells(17, 6), 7, 4) ' Mid(F17, 7, 4) '年龄
r(1, 4) = IIf(Val(Mid(Cells(17, 6), 15, 3)) Mod 2 = 1, "男", "女")
r(1, 5) = Mid(Cells(17, 6), 7, 4) & "-" & Mid(Cells(17, 6), 11, 2)
r(1, 6) = Mid(Cells(17, 6), 11, 2) & "月" & Mid(Cells(17, 6), 13, 2) & "日"

End If
r(c, 1) = c - 4 '序号
r(c, 4) = Cells(2, 2) '姓名
r(c, 5) = Cells(2, 6) '工号
r(c, 6) = Cells(2, 11) '出生年月
r(c, 7) = Cells(3, 2) '性别
r(c, 8) = Cells(3, 6) '民族
r(c, 9) = Cells(3, 11) '政治面貌
r(c, 10) = Cells(4, 2) '籍贯
r(c, 11) = Cells(4, 6) '出生地
r(c, 12) = Cells(4, 11) '入党时间
r(c, 13) = Cells(5, 2) '毕业时间
r(c, 14) = Cells(5, 6) '进入公司时间
r(c, 15) = Cells(5, 11) '手机号码
r(c, 16) = Cells(6, 2) '身份证号码
r(c, 17) = Cells(6, 9) '户籍所在地
r(c, 18) = Cells(6, 14) '最高学历(3, 20).Text
r(c, 19) = Cells(7, 2) '现居住地址
r(c, 20) = Cells(7, 14) '邮政编码
r(c, 21) = Cells(8, 2) '紧急联系人
r(c, 22) = Cells(8, 6) '与本人关系
r(c, 23) = Cells(8, 11) '紧急联系人电话号码
r(c, 24) = Cells(9, 2) '职业资格证书名称
r(c, 25) = Cells(9, 11) '取证时间
r(c, 26) = Cells(10, 2) '职称等级、专业
r(c, 27) = Cells(10, 11) '评审时间
r(c, 28) = Cells(11, 2) '适任证书
r(c, 29) = Cells(11, 9) '发证时间
r(c, 30) = Cells(11, 14) '外语语种、等级
r(c, 31) = Cells(12, 2) '任职部门
r(c, 32) = Cells(12, 6) '任职岗位
r(c, 33) = Cells(12, 11) '任职时间
r(c, 34) = Cells(13, 2) '本人优势
r(c, 35) = Cells(14, 2) '本人不足
r(c, 36) = Cells(13, 11) '职业目标 (或希望发展方向)
r(c, 37) =                                                                  ’学历
ActiveWorkbook.Close savechanges = False
End With
End If
Next
Unload loadingbar
Application.ScreenUpdating = True

End Sub

这是我参考论坛里写的代码，
需要多个单元格合并到一个。


怎么实现这个功能呢？