Solved: Copying comments from one workbook to another

[primaryteach]

Hi all,

I have a bit of code that copies values from one workbook to another (full code at bottom of post).

ThisWorkbook.Worksheets("Sheet1").Range("A7", "J128").Value = wb.Worksheets("Sheet1").Range("A7", "J128").Value

However, I would also like it to copy comments associated with those cells at the same time, without copying any formatting information(e.g. conditional formatting).

Can anyone offer an amendment to the code to make this possible?

Thanks, Simon


Sub Transfer()
Dim wb As Workbook
Dim wsSheet As Worksheet
Dim sFileName As String
sFileName = Application.GetOpenFilename
If sFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(sFileName)
For Each wsSheet In wb.Worksheets
wsSheet.Visible = xlSheetVisible
Next wsSheet
ThisWorkbook.Worksheets("Sheet1").Range("A7", "J128").Value = wb.Worksheets("Sheet1").Range("A7", "J128").Value
wb.Close
Set wb = Nothing
End Sub

[Kenneth Hobs]

Sub Transfer()
Dim wb As Workbook
Dim wsSheet As Worksheet
Dim sFileName As String
Dim c As Range
sFileName = Application.GetOpenFilename
If sFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(sFileName)
For Each wsSheet In wb.Worksheets
wsSheet.Visible = xlSheetVisible
Next wsSheet
ThisWorkbook.Worksheets("Sheet1").Range("A7", "J128").Value = wb.Worksheets("Sheet1").Range("A7", "J128").Value
For Each c In ThisWorkbook.Worksheets("Sheet1").Range("A7", "J128")
On Error Resume Next
c.AddComment.Text (wb.Worksheets("Sheet1").Range(c.Address).Comment.Text)
Next c
wb.Close
Set wb = Nothing
End Sub

[primaryteach]

Thanks Kenneth