Comments to move with cell in macro

[nparsons75]

Hi,

I have a macro that copies and pastes cells from one column to the next to the right. This works fine but does not copy any comments that are attached to the cell, they remain in the original cell. Is there a way to ensure comments move with the cells within the macro?

My code is:

Sub Macro2()    Application.ScreenUpdating = False
    Sheets("Tracker").Select
    Range("B12:J61").Select
    ActiveWindow.SmallScroll Down:=-18
    Sheets("OUTPUT").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Tracker").Select
    Range("K8:K61").Select
    Selection.Copy
    Sheets("OUTPUT").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Sheets("Tracker").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("B12:J61").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-15
    Range("C12").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("B12:B61").Select
    Selection.ClearContents
End Sub


Sub Macro3()






If Range("B11").Value = 0 Then
Range("B1").Value = result
    Application.ScreenUpdating = False
    Range("C12:K61").Select
    Selection.Copy
    Range("B12").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("K12:K61").Select
    Selection.ClearContents
    Sheets("OUTPUT").Select
    Range("A5:A54").Select
    Selection.Copy
    Sheets("Tracker").Select
    Range("K12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("OUTPUT").Select
    Columns("A:A").Select
    Range("A31").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Sheets("Tracker").Select


Else


MsgBox "NO UNDO AVAILABLE"




    End If
End Sub

Thanks,

 

[AdamTrees]

You just add in another selection.pastespecial command once the values are copied over, add this:-

Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Hows that ?

 

[nparsons75]

The good news is that it can be done....Thank you..

Im not sure where I would include it into the code? Would you know? Im not great with VBA, someone else created the code for me.

Thank you for your time.

 

[nparsons75]

This is what I tried but failed:

Does it automatically copy the comments with selection.copy

Sub Macro2()    Application.ScreenUpdating = False
    Sheets("Tracker").Select
    Range("B12:J61").Select
    ActiveWindow.SmallScroll Down:=-18
    Sheets("OUTPUT").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Tracker").Select
    Range("K8:K61").Select
    Selection.Copy
    Sheets("OUTPUT").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Sheets("Tracker").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("B12:J61").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-15
    Range("C12").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("B12:B61").Select
    Selection.ClearContents
End Sub


Sub Macro3()






If Range("B11").Value = 0 Then
Range("B1").Value = result
    Application.ScreenUpdating = False
    Range("C12:K61").Select
    Selection.Copy
    Range("B12").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("K12:K61").Select
    Selection.ClearContents
    Sheets("OUTPUT").Select
    Range("A5:A54").Select
    Selection.Copy
    Sheets("Tracker").Select
    Range("K12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
    Sheets("OUTPUT").Select
    Columns("A:A").Select
    Range("A31").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Sheets("Tracker").Select


Else


MsgBox "NO UNDO AVAILABLE"




    End If
End Sub

 

[AdamTrees]

Sorry for the delay in replying,

I needed a few more lines of code - have just stepped through your macro. The below works for me now, I think the entire code could be simplified / improved
if I could see exactly what was needed. Seems like too many lines for a simple task..

Sub Macro2()
Application.ScreenUpdating = False
Sheets("Tracker").Select
Range("B12:J61").Select
ActiveWindow.SmallScroll Down:=-18
Sheets("OUTPUT").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Tracker").Select
Range("K8:K61").Select
Selection.Copy
Sheets("OUTPUT").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
Sheets("Tracker").Select
ActiveWindow.SmallScroll Down:=-15
Range("B12:J61").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-15
Range("C12").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Range("b13").CurrentRegion.Rows.Select
Selection.Copy
Range("c12").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Range("B12:B61").Select
Selection.ClearContents
End Sub

Hope that helps?!