Appliquer un code sur toutes les feuilles et enregistrer une copie

Bonjour à tous,

J'ai une fichier composé de 5 feuilles et je souhaite appliquer une condition sur toutes ces feuilles là afin que je puisse supprimer des colonnes si la cellule est vide. je veux aussi enregistrer une copie et ne pas travailler directement sur le fichier d'origine. Le problème ce que la macro ne s'applique que sur la première feuille.

Voici le Code vba :

Sub toutesfeuilles()            
    Dim xSh As Worksheet

Sheets(Array("2020", "2021","2023", "2024", "2025")).Select
    Sheets("2020").Activate
Sheets(Array("2020", "2021","2023", "2024", "2025")).Copy    

    Application.ScreenUpdating = False
    For Each xSh In ActiveWorkbook.Worksheets
        xSh.Select

        Call Selection_nature_HUM
    Next
    Application.ScreenUpdating = True
End Sub

------------------
Sub Selection_nature_HUM()

Dim dc As Long
Dim ic As Long
Dim nom As String

    dc = Cells(2, Columns.Count).End(xlToLeft).Column

    For ic = dc To 4 Step -1

    If Cells(2, ic) = 0 Then

    Cells(2, ic).EntireColumn.Delete

    End If

    Next

    nom = Sheets("2020").Range("D3").Value

    ChDir _
        "C:\Users\name\Desktop\tot\Rkif"
    ActiveWorkbook.SaveAs filename:=Path & nom & ".xlsx"
    ActiveWindow.Close

End Sub

Pourriez vous m'aider svp.

Merci

Bonjour,

Les instructions "Select" et "ChDir" sont absolument inutiles. Ci-dessous code indenté:

Sub toutesfeuilles()
    Dim xSh As Worksheet
    Dim chemin As String, nom As String

    Sheets(Array("2020", "2021", "2023", "2024", "2025")).Copy

    Application.ScreenUpdating = False

    For Each xSh In ActiveWorkbook.Worksheets
        Selection_nature_HUM xSh
    Next xSh

    chemin = CreateObject("Wscript.Shell").specialfolders("Desktop") & "\'"
    nom = Sheets("2020").Range("D3").Value
    ActiveWorkbook.SaveAs Filename:=chemin & nom & ".xlsx"
    ActiveWorkbook.Close

    Application.ScreenUpdating = True

End Sub

Sub Selection_nature_HUM(sh As Worksheet)

    Dim ic As Long

    For ic = sh.UsedRange.Columns.Count To 1 Step -1
        If sh.Cells(2, ic) = 0 Then sh.Columns(ic).Delete
    Next ic

End Sub

Bonjour.

Grand Mercii pour votre aide.