Recherche valeur dans+feuilles d'1 classeur

S

spoky

XLDnaute Nouveau
Bonjour à tous
je viens vers vous car je ne trouve pas la solution.
j'ai plusieurs feuilles dans un classeur. ces feuilles sont identiques. je voudrais rechercher dans les colonnes A les valeurs égales à 31 et recopier ces valeurs dans une feuille synthèse qui s'ouvrirait à l'ouverture du classeur. Ou mieux, qu'un message s'affiche à l'ouverture du classeur avec ces valeurs et la désignation correspondante.
 

Pièces jointes

  • EXEMPLE.xlsm
    137.3 KB · Affichages: 34
  • EXEMPLE.xlsm
    137.3 KB · Affichages: 34
  • EXEMPLE.xlsm
    137.3 KB · Affichages: 37
Trier par date Trier par votes
sousou

sousou

XLDnaute Barbatruc
Re : Recherche valeur dans+feuilles d'1 classeur

Bonjour
Ci -jont une macro au démarrage utilisant un module de classe afin d'afficher ce que tu veux
J'espère que cela pourra t'aider
 

Pièces jointes

  • EXEMPLE.xlsm
    150.8 KB · Affichages: 40
  • EXEMPLE.xlsm
    150.8 KB · Affichages: 51
  • EXEMPLE.xlsm
    150.8 KB · Affichages: 40
Vote positif 0 Vote négatif
S

spoky

XLDnaute Nouveau
Re : Recherche valeur dans+feuilles d'1 classeur

Bonjour et merci pour votre réponse aussi rapide. Vous avez trouver la solution, par-contre pourrais-je vous demander quelques améliorations. j'ai essayé de modifier votre code, mais je dois avouer que je ne suis pas doué. Il faudrais que je trouve quelqu'un dans mon village pour me donner des cours de VBA.
Merci à vous et bonne fêtes de fin d'année.
 

Pièces jointes

  • recherche-valeur-dans-feuilles-d1-classeur-exemple.xlsm
    151 KB · Affichages: 20
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Recherche valeur dans+feuilles d'1 classeur

Bonjour spoky, sousou, le forum,

C'est plus simple et plus rapide avec le filtre automatique :

Code: 
Private Sub Workbook_Open()
Dim n, F As Worksheet, w As Worksheet
n = 31 'valeur recherchée, à adapter
Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
F.AutoFilterMode = False 'au cas où...
F.range("A2:I" & F.Rows.Count).Delete xlUp 'RAZ
For Each w In Worksheets
  If w.Name <> F.Name Then
    With Intersect(w.[A:I], w.UsedRange.EntireRow)
      .Columns(9) = "=""" & w.Name & "!A""&" & "ROW()"
      .Columns(9) = .Columns(9).Value 'supprime les formules
      .AutoFilter 1, n 'filtre automatique
      .Offset(1).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
      w.AutoFilterMode = False
      .Columns(9) = ""
    End With
  End If
Next
F.Columns(9).HorizontalAlignment = xlGeneral
F.Columns(9).AutoFit
F.Activate 'facultatif
Application.ScreenUpdating = True
n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1
MsgBox "Vous avez " & n & " contrôles obligatoires à effectuer ce mois-ci !"
End Sub
Fichier joint.

A+
 

Pièces jointes

  • Recherche valeur(1).xlsm
    153.2 KB · Affichages: 33
Vote positif 0 Vote négatif
S

spoky

XLDnaute Nouveau
Re : Recherche valeur dans+feuilles d'1 classeur

Trop fort. Vraiment, je suis impressionné.
Vous n'habitez pas dans les Landes par hasard, j'aurais bien aimé vous rencontrer pour que vous puissiez me former au VBA
Merci encore et franchement BRAVO
BONNES FETES
 
Vote positif 0 Vote négatif
S

spoky

XLDnaute Nouveau
Re : Recherche valeur dans+feuilles d'1 classeur

une dernière petite chose si vous le voulez bien.
dans votre code (n = 31 'valeur recherchée, à adapter)
pourrions nous mettre à la place de" 31" une référence de cellule dans la feuille "synthèse" afin faire une recherche sur différents critères (20,25, etc...)
Merci encore
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Recherche valeur dans+feuilles d'1 classeur

Re,

A dire vrai spoky les "JOURS RESTANTS" en colonnes A ne me paraissent pas bien pertinents puisque vous recherchez les :

contrôles obligatoires à effectuer ce mois-ci
Cliquez pour agrandir...

Maintenant si vous voulez paramétrer leur recherche :

Code: 
Private Sub Workbook_Open()
Dim n, F As Worksheet, w As Worksheet
n = InputBox("Entrez les jours restants recherchés :", "Recherche")
Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
F.AutoFilterMode = False 'au cas où...
F.range("A2:I" & F.Rows.Count).Delete xlUp 'RAZ
If n = "" Then F.[J1] = "": Exit Sub
For Each w In Worksheets
  If w.Name <> F.Name Then
    w.AutoFilterMode = False 'au cas où...
    With Intersect(w.[A:I], w.UsedRange.EntireRow)
      .Columns(9) = "=""" & w.Name & "!A""&" & "ROW()"
      .Columns(9) = .Columns(9).Value 'supprime les formules
      .AutoFilter 1, n 'filtre automatique
      .Offset(1).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
      w.AutoFilterMode = False
      .Columns(9) = ""
    End With
  End If
Next
F.[J1] = n & " jours restants"
F.Columns(9).HorizontalAlignment = xlGeneral
F.Columns(9).AutoFit
F.Activate 'facultatif
Application.ScreenUpdating = True
n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1
MsgBox "Vous avez " & n & " contrôles obligatoires à effectuer ce mois-ci !"
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Recherche valeur(2).xlsm
    152.8 KB · Affichages: 18
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Recherche valeur dans+feuilles d'1 classeur

Re,

Maintenant si vous voulez rechercher les dates du mois en cours "A FAIRE AVANT" :

- les colonnes A des "JOURS RESTANTS" peuvent être supprimées

- utilisez le filtre avancé.

Voyez donc ce fichier (3) et cette macro :

Code: 
Private Sub Workbook_Open()
Dim F As Worksheet, w As Worksheet, n&
Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
On Error Resume Next 'à cause de .ShowAllData
F.ShowAllData 'au cas où...
F.range("A2:H" & F.Rows.Count).Delete xlUp 'RAZ
For Each w In Worksheets
  If w.Name <> F.Name Then
    w.ShowAllData 'au cas où...
    With Intersect(w.[A:H], w.UsedRange.EntireRow)
      .Columns(8) = "=""" & w.Name & "!F""&" & "ROW()"
      .Columns(8) = .Columns(8).Value 'supprime les formules
      .Cells(2, "IV") = "=AND(YEAR(F2)=YEAR(TODAY()),MONTH(F2)=MONTH(TODAY()))"
      .AdvancedFilter xlFilterInPlace, .Cells(1, "IV").Resize(2) 'filtre avancé
      .Offset(1).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
      w.ShowAllData
      .Columns(8) = "": .Cells(2, "IV") = ""
    End With
  End If
Next
F.Columns(8).HorizontalAlignment = xlGeneral
F.Columns(8).AutoFit
F.Activate 'facultatif
Application.ScreenUpdating = True
n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1
MsgBox "Vous avez " & n & " contrôles obligatoires à effectuer ce mois-ci !"
End Sub
A+
 

Pièces jointes

  • Recherche valeur(3).xlsm
    128.3 KB · Affichages: 24
Vote positif 0 Vote négatif
S

spoky

XLDnaute Nouveau
Re : Recherche valeur dans+feuilles d'1 classeur

Merci Job75, c'est vraiment super. Je pense que je vais utiliser ta macro avant. Elle me permet une fois la synthèse faite d'aller voir sur les feuilles les cellules ayant la valeur "31" et faire le nécessaire. Penses-tu que l'on puisse adapter cette macro sur des feuilles avec plus de colonnes ?
Option Explicit

Private Sub Workbook_Open()
Dim n, F As Worksheet, w As Worksheet
n = 31 'valeur recherchée, à adapter-
Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
F.AutoFilterMode = False 'au cas où...
F.range("A2:I" & F.Rows.Count).Delete xlUp 'RAZ
For Each w In Worksheets
If w.Name <> F.Name Then
With Intersect(w.[A:I], w.UsedRange.EntireRow)
.Columns(9) = "=""" & w.Name & "!A""&" & "ROW()"
.Columns(9) = .Columns(9).Value 'supprime les formules
.AutoFilter 1, n 'filtre automatique
.Offset(1).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
w.AutoFilterMode = False
.Columns(9) = ""
End With
End If
Next
F.Columns(9).HorizontalAlignment = xlGeneral
F.Columns(9).AutoFit
F.Activate 'facultatif
Application.ScreenUpdating = True
n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1
MsgBox " & n & " contrôles obligatoires doivent-être effectués ce mois-ci !", vbOKOnly + vbExclamation + vbApplicationModal,
End Sub
Merci et bon Dimanche
Bernard
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Recherche valeur dans+feuilles d'1 classeur

Bonjour spoky,

S'agissant de contrôles, ceux-ci peuvent se traduire par un "X" en colonne H.

Les lignes contrôlées du mois ne s'afficheront donc pas en feuille "Synthèse" :

Code: 
Sub Recherche(Optional ouvre As Boolean = False)
Dim F As Worksheet, w As Worksheet, n&
Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
On Error Resume Next 'à cause de .ShowAllData
F.ShowAllData 'au cas où...
F.range("A2:H" & F.Rows.Count).Delete xlUp 'RAZ
For Each w In Worksheets
  If w.Name <> F.Name Then
    w.ShowAllData 'au cas où...
    With Intersect(w.[A:IU], w.UsedRange.EntireRow)
      .Columns("IU") = .Columns(8).Value 'mémorise en colonne IU
      .Columns(8) = "=""" & w.Name & "!F""&" & "ROW()"
      .Columns(8) = .Columns(8).Value 'supprime les formules
      .Cells(2, "IV") = "=AND(YEAR(F2)=YEAR(TODAY()),MONTH(F2)=MONTH(TODAY()),IU2="""")"
      .AdvancedFilter xlFilterInPlace, .Cells(1, "IV").Resize(2) 'filtre avancé
      .Offset(1).Resize(, 8).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
      .AdvancedFilter xlFilterInPlace, ""
      .Cells(2, "IV") = ""
      .Columns(8) = .Columns("IU").Value 'restitue en colonne H
      .Columns("IU") = ""
    End With
  End If
Next
F.Columns(8).HorizontalAlignment = xlGeneral
F.Columns(8).AutoFit
If ouvre Then
  With Application
    .EnableEvents = False: F.Activate: .EnableEvents = True: .ScreenUpdating = True
  End With
  n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1
  MsgBox "Vous avez " & n & " contrôles obligatoires à effectuer ce mois-ci !"
End If
End Sub
La macro est appelée par la Workbook_Open ou par la Worksheet_Activate.

Fichier (4).

A+
 

Pièces jointes

  • Recherche valeur(4).xlsm
    131.3 KB · Affichages: 19
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Recherche valeur dans+feuilles d'1 classeur

Re,

Deux améliorations dans ce fichier (5).

1) Nouveau critère de filtrage qui permet de récupérer aussi les lignes non contrôlées des mois précédents :

Code: 
.Cells(2, "IV") = "=AND(F2<SIGN(F2)*DATE(YEAR(TODAY()),MONTH(TODAY())+1,1),IU2="""")"
2) Le double-clic en colonne H de la feuille "Synthèse" :

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
With Sheets(Split(Target, "!")(0))
  .Activate
  With .Range(Split(Target, "!")(1))
    ActiveWindow.ScrollRow = .Row
    .Select
  End With
End With
End Sub
A+
 

Pièces jointes

  • Recherche valeur(5).xlsm
    134.5 KB · Affichages: 30
Vote positif 0 Vote négatif
S

spoky

XLDnaute Nouveau
Re : Recherche valeur dans+feuilles d'1 classeur

Merci encore Job75, vous êtes vraiment très doué. Je pense néanmoins conserver celle-ci
Private Sub Workbook_Open()
Dim n, F As Worksheet, w As Worksheet
n = 31 'valeur recherchée, à adapter
 Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
F.AutoFilterMode = False 'au cas où...
F.range("A2:I" & F.Rows.Count).Delete xlUp 'RAZ
For Each w In Worksheets
If w.Name <> F.Name Then
With Intersect(w.[A:I], w.UsedRange.EntireRow)
.Columns(9) = "=""" & w.Name & "!A""&" & "ROW()"
.Columns(9) = .Columns(9).Value 'supprime les formules
.AutoFilter 1, n 'filtre automatique
.Offset(1).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
w.AutoFilterMode = False
.Columns(9) = ""
End With
End If
Next
F.Columns(9).HorizontalAlignment = xlGeneral
F.Columns(9).AutoFit
F.Activate 'facultatif
Application.ScreenUpdating = True
n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1
MsgBox "Vous avez " & n & " contrôles obligatoires à effectuer ce mois-ci !"
End Sub
par-contre pensez-vous qu'il soit possible de mettre une cellule validation dans la feuille synthèse avec la possibilité de choisir la valeur à trier à la place de cette ligne de code :n = 31 'valeur recherchée, à adapter
Mais ceci n'a pas d'urgence, l'urgence maintenant, c'est les jours qui viennent, en famille. Bonne fêtes de fin d'année JOB75.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Recherche valeur dans+feuilles d'1 classeur

Bonjour spoky,

spoky à dit:
par-contre pensez-vous qu'il soit possible de mettre une cellule validation dans la feuille synthèse avec la possibilité de choisir la valeur à trier à la place de cette ligne de code :n = 31 'valeur recherchée, à adapter
Cliquez pour agrandir...

n = Sheets("Synthèse").[A1] c'est du niveau jardin d'enfant...

Bonne fêtes à vous aussi.
 
Vote positif 0 Vote négatif
S

spoky

XLDnaute Nouveau
job75

Bonjour JOB75

Le "joueur de bac à sable" reviens vers vous toujours pour le même classeur !
Je reconnais que je suis nul dans ce domaine...

Je cherche un code vba qui rechercherait les valeurs comprise entre 0 et 31. Ces valeurs se trouvent sur la première colonne des feuilles du classeur, puis de les recopier sur une feuille "synthèse" de ce même classeur. Voici un des codes que vous m'aviez fourni il y a quelques temps.

Private Sub Workbook_Open()
Dim n, F As Worksheet, w As Worksheet
n = Sheets("Synthèse").[A1]
n = 30 'valeur recherchée, à adapter-
Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
F.range("A2:I" & F.Rows.Count).Delete xlUp 'RAZ
FoAutoFilterMode = False 'au cas où...
F.r Each w In Worksheets
If w.Name <> F.Name Then
With Intersect(w.[A:I], w.UsedRange.EntireRow)
.Columns(9) = "=""" & w.Name & "!A""&" & "ROW()"
.Columns(9) = .Columns(9).Value 'supprime les formules
.AutoFilter 1, n 'filtre automatique
.Offset(1).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
w.AutoFilterMode = False
.Columns(9) = ""
End With
End If
Next
F.Columns(9).HorizontalAlignment = xlGeneral
F.Columns(9).AutoFit
F.Activate 'facultatif
Application.ScreenUpdating = True
n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1

MERCI d'avance.
 
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Protection automatique des nouvelles feuilles
Réponses
6
Affichages
217
Phil69970
Phil69970
A
  • Question
XL 2019 Convertir un tableau calculé en TCD
2
Réponses
15
Affichages
675
nat54
nat54
medlight
  • Question
Autres Transfert des données d'un classeur à un autre
Réponses
5
Affichages
324
Oneida
Oneida
M
  • Question
XL 2016 Excel UserForm VBA
Réponses
3
Affichages
290
patricktoulon
patricktoulon
R
  • Question
Microsoft 365 aide a la creation d un classeur commercial
2
Réponses
17
Affichages
723
Rozey
R
C
  • Résolu(e)
Microsoft 365 Recherche une valeur
Réponses
6
Affichages
144
CathU
C
Yuby
  • Question
XL 2013 Copier une même cellule de plusieurs feuilles Excel dans un autre classeur
Réponses
7
Affichages
642
job75
job75
S
  • Question
XL 2019 Recherche de valeur dans un tableau pour afficher la valeur extraite
Réponses
8
Affichages
367
Skippy
S
I
  • Résolu(e)
Microsoft 365 Mise à jour requête dans Power Query
Réponses
1
Affichages
314
ivan27
I
A
  • Question
XL 2016 Copie automatisée des sous-catégories avec VBA
Réponses
8
Affichages
362
Lolote83
L

Membres actuellement en ligne

13 membres et 95 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 502
Messages
2 089 047
Membres
104 011
dernier inscrit
dfr