insérer des guillemets

Sub Guillemets()
Dim r As Range, nlig&, t, i&, x$
Set r = ActiveSheet.UsedRange
nlig = r.Rows.Count
Set r = Intersect(r.Rows(1), Selection.EntireColumn)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each r In r
  t = r.Resize(nlig + 1).Formula 'au moins 2 cellules
  For i = 1 To nlig 'For i = 2 s'il y a des titres
    x = t(i, 1)
    If x <> "" And Not x Like """*""" Then _
      If Not (x Like "=*" Or IsNumeric(x) Or IsDate(x)) _
        Then t(i, 1) = """" & x & """"
  Next i
  r.Resize(nlig).Formula = t
Next r
End Sub

Set r = Range("B2:D" & Sheets(3).Range("m1").Value)

Sub Guillemets()
Dim w As Worksheet, r As Range, ncol%, t, i&, j%, x$
Set w = ActiveSheet 'à adapter
Set r = Intersect(w.UsedRange, w.[B:D]) 'colonnes contiguës
If r Is Nothing Then Exit Sub
ncol = r.Columns.Count
t = r.Resize(r.Rows.Count + 1, ncol).Formula 'au moins 2 cellules
For i = 1 To r.Rows.Count 'For i = 2 s'il y a des titres
  For j = 1 To ncol
    x = t(i, j)
    If x <> "" And Not x Like """*""" Then _
      If Not (x Like "=*" Or IsNumeric(x) Or IsDate(x)) _
        Then t(i, j) = """" & x & """"
Next j, i
r.Formula = t
End Sub