Actualisation de donnée (web) avec changement d'URL

Sub suppression()
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
    With ws
        If .Name <> "Interrogation" Or .Name <> "CMC" Or .Name <> "Calculs" Then ws.Delete
    End With
Next
Application.DisplayAlerts = True
End Sub

Déjà essayé, je rencontre l'erreur suivante (et toutes les feuilles ont été supprimées sauf "CMC" :

Fais CTRL+G

et donne quel est le nom qui bloque

Sub suppression()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
Debug.Print ws.Name
    With ws
        If .Name <> "Interrogation" Or .Name <> "CMC" Or .Name <> "Calculs" Then ws.Delete
    End With
Next
Application.DisplayAlerts = True
End Sub

Je ne suis pas sûr de comprendre ce que tu me demandes...

Lorsque je mets ton code dans Exécuter, voici ce que j'obtiens :

je suis bête !!

AND et non OR

        If .Name <> "Interrogation" And .Name <> "CMC" And .Name <> "Calculs" Then ws.Delete

cela plante car excel cherche à supprimer la dernière feuille

ajoute option de calcul sinon c'est interminable !

Sub Maj()

timedebut = Now()

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With

Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
Debug.Print ws.Name
    With ws
        If .Name <> "Interrogation" And .Name <> "CMC" And .Name <> "Calculs" Then ws.Delete
    End With
Next

Dim i%, k%, URL$, obj As New DataObject
k = Cells(Rows.Count, [www].Column).End(xlUp).Row
On Error Resume Next

For i = [debut].Row + 1 To k
    DoEvents
    URL = Sheets("Interrogation").Cells(i, [www].Column).Value
    On Error Resume Next
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .Send
        If .Status = 200 Then
            If i > [debut].Row Then
                txt = [avant] & Split(Split(.responseText, [avant])(1), [apres])(0) & [apres]
                obj.SetText txt
                obj.PutInClipboard
                ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
                ActiveSheet.Paste
                ActiveSheet.Name = Sheets("Interrogation").Cells(i, [debut].Column).Value
            End If
        End If
    End With
    Cells.Select
    Selection.ColumnWidth = 40
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit

Next

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With

MsgBox ("Terminé en " & Format((Now() - timedebut), "n' ss''") & " !")

End Sub

C'est parfait, cela fonctionne comme je le souhaiterais ! Merci vraiment Steelson pour ton aide !

Y a-t-il la possibilité de déterminer un ordre pour les feuilles? Lorsque je lance la recherche de données via la macro, "CMC", "Calculs" et "Interrogation" sont désordonnés (l'un est tout à droite de mes feuilles, et les deux autres sont tout à gauche)?

ben, heu, change before en after

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

Steelson a écrit :

ben, heu, change before en after

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

Tout fonctionne, merci infiniment Steelson

parfait !

et sur le coeur si le coeur t'en dis ...