Потому что оно работает только с одной строкой
Sub QQQ()
For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
With Cells(1, I)
If .Value <> "" And Left(.Value, 1) <> """" And Right(.Value, 1) <> """" Then .Value = """" & .Value & """"
End With
Next I
For I = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
With Cells(3, I)
If .Value <> "" And Left(.Value, 1) <> """" And Right(.Value, 1) <> """" Then .Value = """" & .Value & """"
End With
Next I
End Subсгенерировать заголовки из уникальных описанийможно с помощью функции UNIQUE. Пишете =UNIQUE(A1:A100) - получаете список уникальных значений из диапазона ячеек A1:A100
