¿Cómo generar códigos QR en celdas?

https://www.youtube.com/watch?v=KkBEEz-s7l4 

Hola Cesar, primero déjame darte las gracias por contestar. Precisamente de esa página fue de donde obtuve la información de como generar códigos QR, pero lo que no se es como generar mas de uno, como lo comentaba en el post necesito que me genere los códigos QR en la columna C con información de la columna B. Para poder diferenciar que información que debe convertirse en código QR la quiero identificar con asteriscos, es decir que la información que quiero que se convierta en código QR estará en la columna B y dentro de asteriscos, pero como te comento no sé como hacerlo.

Si sabes programación te indico lo que puedes hacer crea una macro que recorra la columna B y que evalúe si tiene el asterico y si lo tiene que asigne la el valor de la columna a la celda A9 y copias la imagen en la celda que corresponde.

Con algo de ayuda en la web se ha logrado lo esperado, pero el proceso es algo lento

Option Explicit
Sub codigos()
Dim img As Shape
Dim zz As Long, w As Long
Application.ScreenUpdating = 0
Call comillas  'Llama a macro comillas
Call borrar     'Llama a macro Borrar
zz = [A2].End(xlDown).Row
For w = 2 To zz   'Para "n" filas con comillas (Bucle)
[D2].FormulaLocal = "=URL_QRCode_SERIES(""qr_code_1"",B2,,""qrCode"")"  'En D2 se inserta la fórmula
With Sheets("Codigos").[B65000].End(xlUp)  'Con...
  .Offset(1) = Sheets("QRCode1").Range("B" & w)  'En hoja Codigos columna B pone el dato
  .Offset(1).RowHeight = 160   'Amplía el renglón a 160 pts
End With   'Cierre del with
For Each img In ActiveSheet.Shapes  'Para cada imagen en hoja QRCode1
  If img.Type = 11 Then  'Si es del tipo 11
     img.Copy  'Copia la imagen
     Sheets("Codigos").[B65000].End(xlUp).Offset(, 1).PasteSpecial xlAll  'Lo pega en hoja Codigos columna B
End If  'Cierre del if
Next
For Each img In ActiveSheet.Shapes  'Para cada imagen
  If img.Type = 11 Then img.Delete    'Borra la imagen en hoja QRCode1
Next
Next w 'Repite el bucle
[A2:B65000].Sort [A2], 1              'Ordena datos en base al Item
[D2].ClearContents                       'Borra fórmula de celda D2
ActiveSheet.DrawingObjects.Delete  'Elimina objeto
Sheets("Codigos").Select  'Se pasa a hoja Codigos
[A1].Select
Application.ScreenUpdating = 1
End Sub
Sub comillas()
'Separa datos con comillas
Dim celda As Range
'Ordena por columna B
[A2:B65000].Sort [B2], 1
[B2].Select
'Inserta fila cuando termina de encontrar datos con comillas
For Each celda In [B2:B65000]
If Left(celda, 1) = """" Then
   celda.Offset(1).Select
Else
celda.EntireRow.Insert
Exit For
End If
Next
'Ordena por item los de comillas
Range("A2", [A2].End(xlDown)).Resize(, 2).Select
Selection.Sort [A2], 1
[A2].Select
End Sub
Sub borrar()
'Teclas CTRL+k
'Borra objetos y ajusta filas hoja Codigos
With Sheets("Codigos")
   .DrawingObjects.Delete
   .[B2:B50000].ClearContents
   .Rows.AutoFit
End With
End Sub