XL 2016 Comment remplacer For Each xOng pour un choix d'onglets et de colonnes ...

X

Xplorer

XLDnaute Nouveau
Bonjour ! s'il vous plait, dans le principe, auriez-vous une idée de ce qu'il faudrait utiliser comme formules, pour appliquer une boucle non pas à tous les onglets
et colonnes d'un classeur, via "For Each xOng" , mais à certaines colonnes choisies, d'onglets choisis ... par exemple .... feuille 1 et feuille 2, colonnes D, G, H .... ?

Merci !
 
Trier par date Trier par votes
X

Xplorer

XLDnaute Nouveau
job75 à dit:
Bonsoir Xplorer,

Utilisez 2 tableaux :

f = Array("Feuil1", "Feuil2")

col = Array("D", "G", "H")

et faites 2 boucles imbriquées sur les éléments de f et de col.

A+
Cliquez pour agrandir...
merci beaucoup !

Je suis en train de me dire que je me suis peut-être trompé dans ma demande. J'essaye d'analyser et mieux comprendre le code écrit par lolotte 83 qui m'a bien aidé.

C'était peut-être pas "for each" .... For each ici a l'air de faire une recherche dans tout le classeur, pour des onglets s'appelant "Cat1", pour y travailler.

Mais ce qu'il se passe dans Cat1 suppose une analyse de tous les onglets et colonnes : c'est ces onglets ci, et colonnes que je voudrais mieux définir.

dans cette portion de code :

Select Case xOng.Name
Case Is <> "CAT1", "macros"
With Sheets(xOng.Name)

.... je devrais peut-être rajouter Case Is <> "feuille1", "feuille2" .... ou plutôt :
Case is <>
f = Array("Feuil1", "Feuil2")
col = Array("D", "G", "H")

?

Voilà le code dans son ensemble :

Sub TEST_XPLORER()
Dim xTablo()
xPreLig = 10
xDerLig = 200
xCpt = 0
With Sheets("CAT1")
.Range("C7:C100").ClearContents
End With
For Each xOng In ThisWorkbook.Sheets
Select Case xOng.Name
Case Is <> "CAT1", "macros"
With Sheets(xOng.Name)
For F = 1 To 50
For Each xCell In .Range(.Cells(xPreLig, F * 1), .Cells(xDerLig, F * 1))
If xCell.Offset(0, 1) = 1 Then
xCpt = xCpt + 1
ReDim Preserve xTablo(1 To xCpt)
xTablo(xCpt) = xCell.Value
End If
Next xCell
Next F
End With
End Select
Next xOng
With Sheets("CAT1")
For F = 1 To UBound(xTablo)
.Range("C" & 7 + F) = xTablo(F)
Next F
End With
End Sub
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
Bonsoir,

VB: 
Sub TEST_XPLORER()
Dim xTablo()
xPreLig = 10
xDerLig = 200
xCpt = 0
    With Sheets("Feuil1")
        .Range("C7:C100").ClearContents
    End With
    For Each xOng In ThisWorkbook.Sheets
        Select Case xOng.Name
            Case Is <> "Feuil1", "Feuil2"
                With Sheets(xOng.Name)
                Col = Array("D", "G", "H")
                    For F = LBound(Col) To UBound(Col)
                        For Each xCell In .Range(.Cells(xPreLig, .Range(Col(F) & "1").Column), .Cells(xDerLig, .Range(Col(F) & "1").Column))
                            If xCell.Offset(0, 1) = 1 Then
                                xCpt = xCpt + 1
                                ReDim Preserve xTablo(1 To xCpt)
                                xTablo(xCpt) = xCell.Value
                            End If
                        Next xCell
                    Next F
                End With
        End Select
    Next xOng
    With Sheets("Feuil1")
        For F = 1 To UBound(xTablo)
            .Range("C" & 7 + F) = xTablo(F)
        Next F
    End With
End Sub
 
Vote positif 0 Vote négatif
X

Xplorer

XLDnaute Nouveau
laurent950 à dit:
Bonsoir,

VB: 
Sub TEST_XPLORER()
Dim xTablo()
xPreLig = 10
xDerLig = 200
xCpt = 0
    With Sheets("Feuil1")
        .Range("C7:C100").ClearContents
    End With
    For Each xOng In ThisWorkbook.Sheets
        Select Case xOng.Name
            Case Is <> "Feuil1", "Feuil2"
                With Sheets(xOng.Name)
                Col = Array("D", "G", "H")
                    For F = LBound(Col) To UBound(Col)
                        For Each xCell In .Range(.Cells(xPreLig, .Range(Col(F) & "1").Column), .Cells(xDerLig, .Range(Col(F) & "1").Column))
                            If xCell.Offset(0, 1) = 1 Then
                                xCpt = xCpt + 1
                                ReDim Preserve xTablo(1 To xCpt)
                                xTablo(xCpt) = xCell.Value
                            End If
                        Next xCell
                    Next F
                End With
        End Select
    Next xOng
    With Sheets("Feuil1")
        For F = 1 To UBound(xTablo)
            .Range("C" & 7 + F) = xTablo(F)
        Next F
    End With
End Sub
Cliquez pour agrandir...
Bonsoir ! merci :)

Si je compare :

For Each xOng In ThisWorkbook.Sheets
Select Case xOng.Name
Case Is <> "CAT1", "macros"
With Sheets(xOng.Name)

avec :

For Each xOng In ThisWorkbook.Sheets
Select Case xOng.Name
Case Is <> "Feuil1", "Feuil2"
With Sheets(xOng.Name)
Col = Array("D", "G", "H")
For F = LBound(Col) To UBound(Col)
For Each xCell In .Range(.Cells(xPreLig, .Range(Col(F) & "1").Column), .Cells(xDerLig, .Range(Col(F) & "1").Column))


dans mon cas, "Cat1" et "macros" , remplacées dans votre cas par "Feuil1" et feuil2" , sont justement des onglets que je n'ai pas besoin de mieux définir, c'est tous les autres onglets qui sont analysés et repris dans "Cat1" que je dois mieux cerner.
Difficile à expliquer
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Xplorer, laurent950,

Pour ne pas traiter les feuilles listées dans le tableau f :
VB: 
Dim f, col, w As Worksheet
f = Array("Feuil1", "Feuil2") 'à adapter
col = Array("D", "G", "H")
For Each w In Worksheets
    If IsError(Application.Match(w.Name, f, 0)) Then
        'suite du code
    End If
Next w
A+
 
Vote positif 0 Vote négatif
X

Xplorer

XLDnaute Nouveau
job75 à dit:
Bonjour Xplorer, laurent950,

Pour ne pas traiter les feuilles listées dans le tableau f :
VB: 
Dim f, col, w As Worksheet
f = Array("Feuil1", "Feuil2") 'à adapter
col = Array("D", "G", "H")
For Each w In Worksheets
    If IsError(Application.Match(w.Name, f, 0)) Then
        'suite du code
    End If
Next w
A+
Cliquez pour agrandir...

Bonjour ! Merci beaucoup Laurent.

Ca signifie que ça exclue les feuilles 1 et 2, leurs colonnes D,G,H, pour ne travailler uniquement sur le reste ?

J'ai essayé d'inclure votre code dans celui que j'ai, mais je dois mal m'y prendre, ça ne fonctionne pas encore :

VB: 
Sub TEST_XPLORER()
Dim f, col, w As Worksheet
f = Array("TEMPS 1", "TEMPS 2")                                  'à adapter
col = Array("E", "F")
For Each w In Worksheets
    If IsError(Application.Match(w.Name, f, 0)) Then
                                                                       'suite du code
    End If
Next w
    Dim xTablo()
    xPreLig = 10                         'Première ligne à tester
    xDerLig = 200                        'Dernière ligne à tester
    xCpt = 0                            'Compteur à zéro (utile pour le tableau virtuel)
    With Sheets("CAT1")                                                                       'On travaille sur l'onglet REPERTOIRE
        .Range("C7:C100").ClearContents                                                             'On efface les anciennes données (Ici C5:C100)
    End With
    For Each xOng In ThisWorkbook.Sheets                                                            'On boucle sur tous les onglets du classeur
        Select Case xOng.Name                                                                       'On récupère le nom de chaque onglet
            Case Is <> "CAT1", "macros"                                                        'Si Nom<>Répertoire ou Nom<>Liste
                With Sheets(xOng.Name)                                                              'On travaille dans l'onglet
                    For f = 1 To 50                                                                  'On boucle 2x (Car 2 tableaux)
                        For Each xCell In .Range(.Cells(xPreLig, f * 1), .Cells(xDerLig, f * 1))    'On boucle le tableau
                            If xCell.Offset(0, 1) = 1 Then                                          'Si la cellule de droite=1
                                xCpt = xCpt + 1                                                     'On rajoute 1 au compteur
                                ReDim Preserve xTablo(1 To xCpt)                                    'On redimentionne le tableau virtuel incrémenté du compteur
                                xTablo(xCpt) = xCell.Value                                          'On inscrit la valeur d ela cellule dans un tableau virtuel
                            End If                                                                  'Fin Si
                        Next xCell                                                                  'Fin Boucle
                    Next f                                                                          'Fin Boucle
                End With                                                                            'Fin travail sur l'onglet
        End Select
    Next xOng                                                                                       'Fin Boucle
    With Sheets("CAT1")                                                                             'On travaille sur l'onglet REPERTOIRE
        For f = 1 To UBound(xTablo)                                                                 'On boucle sur toutes les valeurs du tableau virtuel
            .Range("C" & 7 + f) = xTablo(f)                                                         'On inscrit a/c de la cellule C7 le résultat du tableau virtuel
        Next f                                                                                      'Fi boucle
    End With                                                                                        'Fin travail sur l'onglet
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

Z
  • Question
XL 2010 tableau pour comparer deux colonnes et écrire le résultat dans une troisième colonne
2
Réponses
28
Affichages
2 K
zephir94
Z
W
  • Résolu(e)
XL 2016 VBA For Each dans un For Each
Réponses
8
Affichages
701
RF13
R
N
  • Question
XL 2016 Macro chargement liste arborescence, copier coller fichiers
Réponses
9
Affichages
391
Nermal64
N
C
  • Résolu(e)
Microsoft 365 Amélioration Macro.
Réponses
7
Affichages
329
crazy
C
L
  • Résolu(e)
XL 2019 Comparaison valeurs de deux feuilles et copier-coller des colonnes correspondantes
2
Réponses
15
Affichages
881
Lolexcel
L
H
  • Résolu(e)
XL 2019 Boucle For...Each non fonctionnel et autres soucis de traitement
2
Réponses
15
Affichages
1 K
Staple1600
Staple1600
S
  • Résolu(e)
Microsoft 365 VBA pour copier/coller une plage de cellule dans un autre onglet en fonction de la date
Réponses
8
Affichages
834
Sylvain. B
S
oguruma
POWERQUERY :: Combinaisons (Table.Combine) de dossiers contenant des fichiers .CSV ou des fichiers Excel - V2
Réponses
0
Affichages
276
oguruma
oguruma
R
  • Question
Microsoft 365 ListBox / ListView et combobox avec choix de colonnes
2
Réponses
20
Affichages
3 K
RaVenSs
R
R
  • Résolu(e)
XL 2016 Un petit coup de main pour un code VBA
Réponses
11
Affichages
568
ReneDav14000
R

Membres actuellement en ligne

1 membres et 53 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 294
Messages
2 086 895
Membres
103 404
dernier inscrit
sultan87