excel不同列之间合并

Sub test()
    startMerge Sheet4, Sheet3
    startMerge Sheet6, Sheet3
    startMerge Sheet7, Sheet3
    startMerge Sheet8, Sheet3
    MsgBox "ok!", vbInformation
End Sub
'write new row
Sub setNewRow()
    Dim i%, strTmp$
    For i = 2 To Sheet3.UsedRange.Rows.Count
        Sheet3.Cells(i, 5) = "WXGA+で" & Sheet3.Cells(i, 4) & "(" & Sheet3.Cells(i, 3) & ")：静的なForm"
        Sheet3.Cells(i, 6) = "WSXGA+で" & Sheet3.Cells(i, 4) & "(" & Sheet3.Cells(i, 3) & ")：静的なForm"
    Next
End Sub

'merge objSource to objDirect
Private Sub startMerge(objSource As Object, objDirect As Object)
    Dim i%, strTmp$
    For i = 2 To objSource.UsedRange.Rows.Count
        strTmp = getTitleByID(objSource, objDirect.Cells(i, 1).Text)
        If strTmp <> "" Then objDirect.Cells(i, 4) = strTmp
    Next
End Sub

'get objSheet's title
Private Function getTitleByID(objSheet As Object, strID$) As String
    Dim i%
    For i = 1 To objSheet.UsedRange.Rows.Count
        If objSheet.Cells(i, 1).Text = strID Then
            getTitleByID = Trim(objSheet.Cells(i, 4).Text)
            Exit For
        End If
    Next
End Function