Bonjour,
Essaie ceci en adaptant le nom des feuilles.
Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1
Les résultats sont en Feuil3
'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet
'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")
On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With
Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)
.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------
"swoolj" a écrit dans le message de groupe de
discussion :
Bonjour,
N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.
J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées
Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »
Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche
Merci pour votre aide
Cordialement
Swoolj
Bonjour,
Essaie ceci en adaptant le nom des feuilles.
Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1
Les résultats sont en Feuil3
'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet
'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")
On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With
Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)
.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------
"swoolj" <swoolj@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : 329C2B8D-B2DC-44F6-8F64-F58B58237B0D@microsoft.com...
Bonjour,
N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.
J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées
Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »
Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche
Merci pour votre aide
Cordialement
Swoolj
Bonjour,
Essaie ceci en adaptant le nom des feuilles.
Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1
Les résultats sont en Feuil3
'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet
'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")
On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With
Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)
.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------
"swoolj" a écrit dans le message de groupe de
discussion :
Bonjour,
N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.
J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées
Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »
Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche
Merci pour votre aide
Cordialement
Swoolj
Bonjour,
Essaie ceci en adaptant le nom des feuilles.
Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1
Les résultats sont en Feuil3
'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet
'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")
On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With
Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)
.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------
"swoolj" a écrit dans le message de groupe de
discussion :
Bonjour,
N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.
J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées
Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »
Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche
Merci pour votre aide
Cordialement
Swoolj
Bonjour,
Essaie ceci en adaptant le nom des feuilles.
Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1
Les résultats sont en Feuil3
'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet
'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")
On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With
Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)
.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------
"swoolj" <swoolj@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : 329C2B8D-B2DC-44F6-8F64-F58B58237B0D@microsoft.com...
Bonjour,
N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.
J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées
Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »
Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche
Merci pour votre aide
Cordialement
Swoolj
Bonjour,
Essaie ceci en adaptant le nom des feuilles.
Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1
Les résultats sont en Feuil3
'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet
'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")
On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With
Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)
.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------
"swoolj" a écrit dans le message de groupe de
discussion :
Bonjour,
N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.
J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées
Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »
Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche
Merci pour votre aide
Cordialement
Swoolj