XL 2013 Boucle sur plusieurs feuilles sauf 1

  • Initiateur de la discussion Initiateur de la discussion Regueiro
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Regueiro

XLDnaute Impliqué
Bonsoir le Forum et Bonne Année à Tous.
Voici mon code qui marche pour boucler sur une feuille
Mais j'aimerais boucler sur toutes les feuilles sauf 1 (Feuil4) = ACCUEIL

Code:
Option Explicit
Public Derlig As Long, DerCol As Long
Public Cell As Range
Sub Transfert()
Dim Dico As Object
Dim F As Worksheet
Set F = Worksheets("eric")
MsgBox F.Name
Set Dico = CreateObject("Scripting.Dictionary")

    Derlig = F.Cells(Rows.Count, 3).End(xlUp).Row
    MsgBox Derlig
        For Each Cell In F.Range("C7", F.Cells(Derlig, 3))
            If Cell <> "" Then Dico(Cell.Value) = ""
        Next Cell

With Sheets("ACCUEIL")
[I4].Resize(Dico.Count) = Application.Transpose(Dico.keys)

End With

End Sub
Pour info je dois rajouter plusieurs feuilles avec des noms diééfrents
MErci de votre Aide
 
Re : Boucle sur plusieurs feuilles sauf 1

bonjour,

essayer comme ceci !?

Code:
Option Explicit
Public Derlig As Long, DerCol As Long, Cell As Range
Sub Transfert()
Dim Dico As Object, F As Worksheet
Set Dico = CreateObject("Scripting.Dictionary")
For Each F In Worksheets
    If LCase(F.Name) <> "accueil" Then 'excepté celle-ci !
        Derlig = F.Cells(Rows.Count, 3).End(xlUp).Row
        For Each Cell In F.Range("C7", F.Cells(Derlig, 3))
            If Cell <> "" Then Dico(Cell.Value) = ""
        Next
    End If
Next
If Dico.Count > 0 Then
   With Sheets("ACCUEIL"): .[I4].Resize(Dico.Count) = Application.Transpose(Dico.keys): End With
End If
Set F = Nothing: Set Dico = Nothing
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
316
Réponses
4
Affichages
580
Réponses
3
Affichages
834
Réponses
1
Affichages
606
Retour