Bonjour,
tout d'abaord merci,et ce que tu as fais c'est exactement ce que je veux .
J'ai effectué les modifications en rapport avec mon fichier et quand je clic sur la commandbutton1,
je choisi mon fichier et ma boite de dialogue s"affiche normalement. (heureux)
Mais dans ma zone de filtre, en 'colonne a filtrer j'ai juste 2013 qui apparait au lieu des differents elements de la ligne de titres et pour le filtre je n'est rien du tout.
Je suis allé dans Properties Windows pour changer le nom de la feuille "Sheet1" par "LL" car les informations que je desire (period) se trouvent dans la feuille que j'ai nomé" LL" par example. (sachant qu'il y'a plusieurs feuilles dans mon fichier choisi).
Ou peut etre dois-je inserer un nouveau code pour la recherche de la feuille concerné?
voila ce que j'ai fait en respectant les consignes.
Ai- je omis quelque chose?
Cordialement a tous
Option Explicit
Public WsBase As Worksheet
Public LaColonne As Integer
Public NomCritere As String
Sub Choix_Fichier()
Dim Fichier
Dim WbkSource As Workbook
NomCritere = ""
LaColonne = 0
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Fichier données (*.xlsx), *.xlsx")
If Fichier <> False Then
Application.ScreenUpdating = False
Set WbkSource = Workbooks.Open(Fichier)
Set WsBase = WbkSource.Sheets(1)
ThisWorkbook.Activate
Application.ScreenUpdating = True
UserForm1.Show ' Attention ne pas ouvrir en mode non Modal ( 0 ou vbModeless)
If LaColonne <> 0 And NomCritere <> "" Then
Filtre
End If
WbkSource.Close savechanges:=False
End If
End Sub
Sub Filtre()
Dim Nblg As Long
Dim Ws As Worksheet
Dim NbCl As Integer
Set WbBase = ActiveWorkbook
Application.ScreenUpdating = False
Set Ws = ActiveSheet
' **************************************************************************************
' N1 et N2 sont des cellules situées en dehors du tableau de la page contenant le bouton
' **************************************************************************************
Ws.Range("AC1") = WsBase.Cells(2, LaColonne)
Ws.Range("AC2") = NomCritere
With WsBase
If .FilterMode = True Then .ShowAllData
Nblg = .Cells(Rows.Count, LaColonne).End(xlUp).Row
' *********************************
' Le 2 indique la ligne des titres
' *********************************
NbCl = .Cells(6, Columns.Count).End(xlToLeft).Column
End With
If FeuilleExiste(ThisWorkbook, NomCritere) = False Then
ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = NomCritere
End If
With ThisWorkbook.Sheets(NomCritere)
.Cells.Clear
' **************************************************************************************
' A2 correspond à la 1ère cellule de la ligne des titres
' N1 et N2 sont des cellules situées en dehors du tableau de la page contenant le bouton
' **************************************************************************************
WsBase.Range(WsBase.Range("A6"), WsBase.Cells(Nblg, NbCl)).AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=Ws.Range("AC1:AC2"), copytorange:=.Range(.Range("A1"), .Cells(1, NbCl))
End With
With Ws
' **************************************************************************************
' N1 et N2 sont des cellules situées en dehors du tableau de la page contenant le bouton
' **************************************************************************************
.Range("AC1:AC2").ClearContents
.Select
End With
End Sub
Function FeuilleExiste(WkB As Workbook, Nom As String) As Boolean
On Error Resume Next
FeuilleExiste = WkB.Sheets(Nom).Name <> ""
On Error GoTo 0
End Function