Copy content from list to New Notes of given cells

[Mcstefan]

Hi,
Could anyone help me find/create a vba that does the followings:
- I have two files (source and destination)
- The source file looks like this :

source of new notes.xlsx
	A	B	C
1	file path of the file where the New notes are copied from the current file
2	C:/mydocuments/destination.xlsx
3
4	Content to be copied into New Notes	Worksheet name where the content is copied	Cell reference where the content is copied
5	aaaaaa	sheet1	C2
6	bbbbbb	sheet2	D24
7	cccccccc	sheet2	AA99
8	ddddddd	sheet3	B121
Sheet1

- I would like to copy the content from column A of the source file and paste it in New Notes of the destination file
- The destination worksheets and the cells are indicated in the columns B and C in the source file
- The macro saved in the source file should open the destination file (full path provided in cell A2) and loop through all rows starting from row 5 and down to the last row.
- Ideally the size of the new notes should be adapted based on the length of the content of each cell provided in column A.

Many thanks,
Cristian.

 

[Mcstefan]

Hi,

Can I get some help on converting the recorded macro to an automated one - loop through all rows starting 5?

Sub Macro2()

Workbooks.Open Filename:= _

"M:\Accounting\1_Conso Financial Reports.xlsb"

ActiveWindow.ActivateNext

Range("A5").Select

ActiveCell.FormulaR1C1 = "These ...."

ActiveWindow.ActivateNext

Sheets("NDV_P&L").Select

Range("L160").Select

Range("L160").AddComment

Range("L160").Comment.Visible = False

Range("L160").Comment.Text Text:="CS:" & Chr(10) & "These ....", Start:=200

Selection.ShapeRange.ScaleWidth 1.66, msoFalse, msoScaleFromTopLeft

Selection.ShapeRange.ScaleHeight 1.74, msoFalse, msoScaleFromTopLeft

ActiveWindow.ActivateNext

Range("A6").Select

ActiveCell.FormulaR1C1 = "41K ...."

ActiveWindow.ActivateNext

Sheets("NTS_P&L").Select

Range("Q149").Select

Range("Q149").AddComment

Range("Q149").Comment.Visible = False

Range("Q149").Comment.Text Text:="CS:" & Chr(10) & "41K ...."

Selection.ShapeRange.ScaleWidth 1.33, msoFalse, msoScaleFromTopLeft

Selection.ShapeRange.ScaleHeight 1.44, msoFalse, msoScaleFromTopLeft

End Sub

 

[DanteAmor]

- The destination worksheets and the cells are indicated in the columns B and C in the source file

ok

- The macro saved in the source file should open the destination file (full path provided in cell A2) and loop through all rows starting from row 5 and down to the last row.

ok. Check "C:/mydocuments/destination.xlsx", check Backslash.

- Ideally the size of the new notes should be adapted based on the length of the content of each cell provided in column A.

ok. .Comment.Shape.TextFrame.AutoSize = True

Try this:

Sub Copy_Content_To_New_Notes()
  Dim wb As Workbook
  Dim sh1 As Worksheet
  Dim c As Range
  Dim sFile As String
  Dim i As Long
  
  Application.ScreenUpdating = False
  Set sh1 = ThisWorkbook.Sheets("Sheet1")
  sFile = sh1.Range("A2").Value
  If Dir(sFile) = "" Then
    MsgBox "File does not exists"
    Exit Sub
  End If
  
  Set wb = Workbooks.Open(sFile)
  
  For Each c In sh1.Range("A5", sh1.Range("A" & Rows.Count).End(3))
    With wb.Sheets(c.Offset(, 1).Value).Range(c.Offset(, 2).Value)
      On Error Resume Next: .Comment.Shape.Delete: On Error GoTo 0
      .AddComment
      .Comment.Visible = False
      .Comment.Text Text:="CS:" & Chr(10) & c.Value, Start:=200
      .Comment.Shape.TextFrame.AutoSize = True
    End With
  Next
  wb.Save
  Application.ScreenUpdating = True
End Sub

 

[Mcstefan]

@DanteAmor you are awesome. The code was magic.
Many thanks,
Cristian.

 

[DanteAmor]

Im glad to help you, thanks for the feedback.