Copy content from list to New Notes of given cells

Mcstefan

New Member
Joined
May 17, 2014
Messages
42
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
ABC
1file path of the file where the New notes are copied from the current file
2C:/mydocuments/destination.xlsx
3
4Content to be copied into New NotesWorksheet name where the content is copied Cell reference where the content is copied
5aaaaaasheet1C2
6bbbbbbsheet2D24
7ccccccccsheet2AA99
8dddddddsheet3B121
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.
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

Mcstefan

New Member
Joined
May 17, 2014
Messages
42
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

Well-known Member
Joined
Dec 3, 2018
Messages
13,968
Office Version
  1. 2007
Platform
  1. Windows
- 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:

VBA Code:
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
 
Solution

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,968
Office Version
  1. 2007
Platform
  1. Windows
Im glad to help you, thanks for the feedback.
 

Forum statistics

Threads
1,148,170
Messages
5,745,166
Members
423,929
Latest member
z y

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top