Boucle sur un code

Bonjour à tous,

J'aimerai comprendre comment faire une boucle sur ce petit code qui me sert a ouvrir des fichiers en lien hypertexte et qui vide le contenu de plusieurs tableau. Voici le code que j'aimerai boucler sur les cellule A3 à A54 si cela est possible.

Range("A3").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Range("C2:D4").Select
    Selection.ClearContents
    Range("B8:D10").Select
    Selection.ClearContents
    Range("C13:H17").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=9
    Range("C20:H39").Select
    Selection.ClearContents
    ActiveWorkbook.Save
    ActiveWindow.Close

Merci

Bien cordialement,

bonjour,

une proposition à tester. attention travailler sur des copies car il y a suppression d'informations...

Sub aargh()
    For Each c In Range("A3:A54")
        c.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        With ActiveWorkbook.Sheets(1)
            .Range("C2:D4").ClearContents
            .Range("B8:D10").ClearContents
            .Range("C13:H17").ClearContents
            .Range("C20:H39").ClearContents
        End With
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next c
End Sub

Merci c'est super sa marche.

Oui effectivement je fais une copie du fichier avant et je réinitialise tout, j'ai une autre petite question sur mon code car cela ne fonctionne pas.

J'ai un tableau regroupant des valeurs et j'aimerai a la suite de réinitialiser tout les fichiers en lien hypertexte réinitialiser le tableau mais cela ne fonctionne pas

Voici mon code.

Sub LOL()

Dim nom As String

    Application.ScreenUpdating = False
        nom = "\\C:\Users\mickael.deflorenne\Desktop\peinture\Traçabilité\"
    ChDir "C:\Users\mickael.deflorenne\Desktop\peinture\Traçabilité"
    ActiveWorkbook.SaveAs Filename:=nom & "Contrôle peinture Saison " & Format(Date, "yyyy")

For Each c In Range("A3:A54")
        c.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        With ActiveWorkbook.Sheets(1)
            .Range("C2:D4").ClearContents
            .Range("B8:D10").ClearContents
            .Range("C13:H17").ClearContents
            .Range("C20:H39").ClearContents
        End With
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next c

    Range("B3:L54").Select
    Selection.ClearContents
    Range("B3").Select
ActiveWorkbook.Save

Application.DisplayAlerts = False
Application.Quit

End Sub

Bien cordialement,

bonjour,

désolé, je n'ai pas compris la demande.

Pardon je n'ai pas été assez explicite

Range("B3:L54").Select
    Selection.ClearContents
    Range("B3").Select
ActiveWorkbook.Save

Ce bout de code ne fonctionne pas il ne me vide pas le table de B3 à L54, quand je réouvre le doc les lignes existe toujours comment faire pour que ce bout de code fonctionne

re-bonjour,

essaie ceci,

Sub LOL()

    Dim nom As String
    Set twb = ActiveWorkbook
    Set ws = twb.ActiveSheet
    Application.ScreenUpdating = False
    nom = "\\C:\Users\mickael.deflorenne\Desktop\peinture\Traçabilité\"
    ChDir "C:\Users\mickael.deflorenne\Desktop\peinture\Traçabilité"
    twb.SaveAs Filename:=nom & "Contrôle peinture Saison " & Format(Date, "yyyy")

    For Each c In ws.Range("A3:A54")
        c.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        With ActiveWorkbook.Sheets(1)
            .Range("C2:D4").ClearContents
            .Range("B8:D10").ClearContents
            .Range("C13:H17").ClearContents
            .Range("C20:H39").ClearContents
        End With
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next c

    ws.Range("B3:L54").ClearContents
    ws.Range("B3").Select
    twb.Save

    Application.DisplayAlerts = False
    Application.Quit

End Sub

Le soucis avec le code que tu me transmet est:

il m'enregistre un tableau vide alors que j'aimerai avoir un enregistrement du tableau avec les valeurs et que celui d'origine redevienne vide.

Merci

re-bonjour,

Le soucis avec le code que tu me transmet est:

drôle de formulation, alors que je t'ai fourni ce que tu as demandé ...

voici une adaptation pour ta nouvelle demande.

Sub LOL()

    Dim nom As String
    Set twb = ActiveWorkbook
    Set ws = twb.ActiveSheet
    Application.ScreenUpdating = False
    nom = "\\C:\Users\mickael.deflorenne\Desktop\peinture\Traçabilité\"
    ChDir "C:\Users\mickael.deflorenne\Desktop\peinture\Traçabilité"
    twb.SavecopyAs Filename:=nom & "Contrôle peinture Saison " & Format(Date, "yyyy")

    For Each c In ws.Range("A3:A54")
        c.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        With ActiveWorkbook.Sheets(1)
            .Range("C2:D4").ClearContents
            .Range("B8:D10").ClearContents
            .Range("C13:H17").ClearContents
            .Range("C20:H39").ClearContents
        End With
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next c

    ws.Range("B3:L54").ClearContents
    ws.Range("B3").Select
    twb.Save

    Application.DisplayAlerts = False
    Application.Quit

End Sub

Je vais réexpliquer mon soucis car j'ai un beug sur une ligne et je ne comprend pas

le ligne en question est la suivant

twb.SaveCopyAs Filename:=nom & "Contrôle peinture Saison " & Format(Date, "yyyy")

avec pour erreur "erreur d'excution 1004"

J'ai dans un fichier excel nommé "A" avec un tableau de valeur et des courbes.

1) Je voudrai enregistrer une copie de "A" nommé "B" dans un dossier à coté pour en garder une trace

2) Je voudrai pouvoir remettre a jour le fichier "A" en supprimant des données dans les fichiers avec le lien hypertexte

3) Et aussi dans l'onglet "contrôle" de mon fichier "A" en supprimant des données allant de B3 à L54

Voila j'espère avoir été assez clair désolé de ne pas mettre fait comprendre avant.

edit :

De plus si pour le nom de la copie du fichier "A" s'il pouvait s'appeler "B-année passé-année en cours

Merci

re-bonjour,

enlève les \\ avant le c:\ dans l'instruction

 nom = "\\C:\Users\mickael.deflorenne\Desktop\peinture\Traçabilité\"

Bonsoir,

Désolé mais cela ne fonctionne pas comme je le souhaiterai, je referai un essai demain et au pire je referai un sujet avec de meilleurs explication et des exemples

Merci en tout cas de ton aide.