Est-ce que tu as une erreur sur le fichier que je t'ai posté ?
Pour la macro ...
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Left(Sh.Name, 4) = "Type" Then
Sheets(1).Cells(Rows.Count, 1).End(xlUp).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sh.Range("B1").CurrentRegion, CopyToRange:=Sh.Range("A4").CurrentRegion.Resize(1), Unique:=False
End If
End Sub
- 1- Je prends les feuilles dont le nom commence par Type
Attention ... si tu es en cours de mise en place, la macro va s'activer alors que tu n'as pas encore positionné les données ! Dans ce cas mets provisoirement un autre nom comme _Type 1
de façon à bloquer la macro
- 2- Le filtre prend comme données
c'est une façon assez universelle de les identifier
mais cela veut dire :
la première feuille du classeur
- rien en dessous des données car
Cells(Rows.Count, 1).End(xlup)
signifie que l'on remonte depuis la fin ultime de la feuille colonne 1, et qu'on prend la "région"
- données collées en colonne 1
- 3- Les critères sont en B1:B2 ici (
Range("B1").CurrentRegion)
, dans B1 il y a le titre de la colonne avec la même orthographe, strictement
- 4- Les résultat se situe sur la ligne 4 (
CopyToRange:=Sh.Range("A4").CurrentRegion.Resize(1)
)
Les 2, 3 et 4 peuvent aussi s'écrire de façon plus adaptée à ton sujet. Exemple :
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Left(Sh.Name, 4) = "Type" Then
Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sh.Range("B1:B2"), CopyToRange:=Sh.Range("A4:H4"), Unique:=False
End If
End Sub
ou mieux
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Left(Sh.Name, 4) = "Type" Then
Sheets("Sheet1").Range("Table1[#All]").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sh.Range("B1:B2"), CopyToRange:=Sh.Range("A4:H4"), Unique:=False
End If
End Sub