Recherche internet à partir de cellules excel

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim SortiEn
If Target.Column <> 1 Or Target.Value = "" Then Exit Sub
    Cancel = True
    Application.ScreenUpdating = False
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.google.fr/search?hl=fr&source=hp&q=" & CStr(Target.Value) & " &meta=&aq=f&oq=" _
        , Destination:=ActiveSheet.Range("$A$1"))
        .Name = "search?hl=fr&source=hp&q=Code%20Meurtre&meta=&aq=f&oq="
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    SortiEn = ActiveSheet.Cells.Find(What:="Film (????)", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Value
    Target.Offset(, 1) = Mid(SortiEn, 7, 4)
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
End Sub

Sub toutes()
Dim xrg As Range, xcell As Range

Set xrg = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
  For Each xcell In xrg
    Sheets("Feuil1").Worksheet_BeforeDoubleClick xcell, True
  Next xcell
End Sub