Sub cmmnts()
Dim wb As Workbook
Dim sht As Worksheet
Dim sht2 As Worksheet
Dim cmt As Comment
Dim cmt2 As Comment
'assuming that the source workbook is currently open
Set wb = Workbooks("book1")
For Each sht In wb.Sheets
On Error Resume Next
Set sht2 = ActiveWorkbook.Sheets(sht.Name)
On Error GoTo 0
If Not sht2 Is Nothing Then
For Each cmt In sht.Comments
With sht2.Range(cmt.Parent.Address)
Set cmt2 = .Comment
If cmt2 Is Nothing Then
.AddComment
.Comment.Text cmt.Text
End If
Set cmt2 = Nothing
End With
Next cmt
Set sht2 = Nothing
End If
Next sht
Set wb = Nothing
End Sub