Experimente. Resultado na coluna 'D'.

Sub ConcatLoja()
 Dim k As Long, x As Long, m As Long, LR As Long
 [D:D] = ""
 For k = 2 To Cells(Rows.Count, 1).End(3).Row
  x = Application.CountIf([A:A], Cells(k, 1))
   LR = Cells(Rows.Count, 4).End(3).Row
   For m = 0 To x - 1
    Cells(LR + 1, 4) = Cells(LR + 1, 4) & "n" & Cells(k + m, 2)
   Next m
   Cells(LR + 1, 4) = Right(Cells(LR + 1, 4), Len(Cells(LR + 1, 4)) - 2)
  k = k + x - 1
 Next k
End Sub

Osvaldo, sensacional!!! Resolveu meu problema!!!

Porém, eu precisava colocar mais um "n" no final da string. No meu caso ficou assim:

ACETONA FARMAX 100ML - 68335nACETONA FARMAX 500ML - 68334nAGUA OXIGENADA CREMOSA FARMAX 20 VOL. 90ML - 81012

mas eu precisava de mais uma no final:

ACETONA FARMAX 100ML - 68335nACETONA FARMAX 500ML - 68334nAGUA OXIGENADA CREMOSA FARMAX 20 VOL. 90ML - 81012n

Como altero o seu codigo para atender essa expectativa?

Acrescente a parte em vermelho:

Cells(LR + 1, 4) = Right(Cells(LR + 1, 4), Len(Cells(LR + 1, 4)) - 2) & "n"

Se você quiser experimentar também o código abaixo, o resultado será igual porém a execução será mais rápida do que o código anterior.

Sub ConcatLojaV2()
 Dim k As Long, x As Long, m As Long, LR As Long, r As String
  [D:D] = ""
  For k = 2 To Cells(Rows.Count, 1).End(3).Row
   x = Application.CountIf([A:A], Cells(k, 1))
   LR = Cells(Rows.Count, 4).End(3).Row
    For m = 0 To x - 1
     r = r & "n" & Cells(k + m, 2)
    Next m
   Cells(LR + 1, 4) = Right(r, Len(r) - 2) & "n"
   k = k + x - 1: r = ""
  Next k
End Sub