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
