Sub Примечание()
LastCell = Cells(Rows.Count, 4).End(xlUp).Row
magazin = Array("Магазин №1", "Магазин №2", "Магазин №4", "Магазин №6")
For j = 13 To 37 Step 8
Set sh = Sheets(magazin(m))
LastCell2 = sh.Cells(Rows.Count, 3).End(xlUp).Row
      For i = 10 To LastCell
      SKU = Cells(i, 2)
      toComm = ""
          For k = 2 To LastCell2
              If sh.Cells(k, 1) = SKU Then toComm = sh.Cells(k, 8).Value: Exit For
          Next k
      If Not Cells(i, j).Comment Is Nothing Then Cells(i, j).ClearComments
      If toComm <> "" Then
          Cells(i, j).NoteText Text:=toComm
          Cells(i, j).Comment.Shape.TextFrame.AutoSize = True
      End If
      Next i
m = m + 1
Next j
End Sub

Sub Примечание()
Dim key1, result1, SKU
LastCell = Cells(Rows.Count, 4).End(xlUp).Row
magazin = Array("Магазин №1", "Магазин №2", "Магазин №4", "Магазин №6")
For j = 13 To 37 Step 8
Set sh = Sheets(magazin(m))
LastCell2 = sh.Cells(Rows.Count, 3).End(xlUp).Row
key1 = sh.Range("A2:A" & LastCell2).Value
result1 = sh.Range("H2:H" & LastCell2).Value
SKU = [B1].Resize(LastCell, 1).Value
     For i = 10 To LastCell
     toComm = ""
         For k = 1 To UBound(key1)
             If key1(k, 1) * 1 = SKU(i, 1) * 1 Then toComm = result1(k, 1): Exit For
         Next k
     If toComm = "" And Not Cells(i, j).Comment Is Nothing Then Cells(i, j).ClearComments
     If toComm <> "" Then
         Cells(i, j).NoteText Text:=toComm
         Cells(i, j).Comment.Shape.TextFrame.AutoSize = True
     End If
     Next i
m = m + 1
Next j
End Sub

Sub Примечание()
Dim key1, result1, SKU
LastCell = Cells(Rows.Count, 4).End(xlUp).Row
magazin = Array("Магазин №1", "Магазин №2", "Магазин №4", "Магазин №6")
For j = 13 To 37 Step 8
Set sh = Sheets(magazin(m))
LastCell2 = sh.Cells(Rows.Count, 3).End(xlUp).Row
key1 = sh.Range("A2:H" & LastCell2).Value
SKU = [B1].Resize(LastCell, 1).Value
     For i = 10 To LastCell
     On Error Resume Next
     toComm = Trim(Application.WorksheetFunction.VLookup(SKU(i, 1) * 1, key1, 8, 0))
     If Err <> 0 Then toComm = ""
     If toComm <> "" Then
         Cells(i, j).NoteText Text:=toComm
         Cells(i, j).Comment.Shape.TextFrame.AutoSize = True
     End If
     If toComm = "" And Not Cells(i, j).Comment Is Nothing Then Cells(i, j).ClearComments
     On Error GoTo 0
     Next i
m = m + 1
Next j
End Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

Option Explicit

Sub tt()
      Dim tm!: tm = Timer
      Dim adr, magazin, a(), h(), i&, ii&, lc&, el, s$
      adr = Array("M", "U", "AC", "AK")
      magazin = Array("Магазин №1", "Магазин №2", "Магазин №4", "Магазин №6")

'    Application.ScreenUpdating = False
'    Application.EnableEvents = False

      With Sheets("АНАЛИТ")
          lc = .Cells(.Rows.Count, 3).End(xlUp).Row
          a = .Range("B10:B" & lc).Value
          .Range("M10:AK" & lc).ClearComments
      End With

      With CreateObject("scripting.dictionary")
          'заполняем словарь адресами ячеек артикул/магазин
          For i = 1 To UBound(a)
              For ii = 0 To UBound(adr)
                  .Item(a(i, 1) & "|" & magazin(ii)) = adr(ii) & i + 9
              Next
          Next

          For Each el In magazin 'цикл по листам
              With Sheets(el)
                  lc = .Cells(.Rows.Count, 1).End(xlUp).Row
                  a = .Range("A2:A" & lc).Value
                  h = .Range("H2:H" & lc).Value
              End With
              For i = 1 To UBound(a) 'цикл по данным листа
                  If Len(h(i, 1)) Then 'если есть что писать в примечание
                      s = .Item(a(i, 1) & "|" & el) 'извлекаем адрес
                      With Sheets("АНАЛИТ").Range(s) 'пишем примечание
                          .NoteText Text:=h(i, 1)
                          .Comment.Shape.TextFrame.AutoSize = True
                      End With
                  End If
              Next
          Next

      End With

'    Application.ScreenUpdating = True
'    Application.EnableEvents = True

      MsgBox Timer - tm
End Sub