XL 2010 Extraction de données suivant onglets (msgbox)

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

GV91

XLDnaute Junior
Bonjour,

Ci-joint un code VBA me permettant une de faire une requête d'un fichier Excel source "AA", ce fichier source possédant 31 onglets soit un par jour.

Ici j'ai fait un test (concluant) sur le jour 2 (2$ en ligne 13), mon problème est que j'aimerai avoir une msgbox me permettant de modifier ce chiffre suivant le jour que je veux dans mon fichier source "AA"

Je n'arrive pas à incorporer ce paramètre dans mon code.

D'avance merci pour toute collaboration.


Sub Macro2()
'
' Macro2 Macro
'

'
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Users\Gravina.A\Desktop\test pour connexion\Suivi mouvements stock\2020\AA.xlsm;DefaultDir=C:\Users\Grav" _
), Array( _
"ina.A\Desktop\test pour connexion\Suivi mouvements stock\2020;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("$A$3")).QueryTable
.CommandText = Array( _
"SELECT `'2$'`.Date, `'2$'`.Emplacement, `'2$'`.Motif" & Chr(13) & "" & Chr(10) & "FROM `'2$'` `'2$'`")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files"
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-27
ActiveSheet.ListObjects("Tableau_Lancer_la_requête_à_partir_de_Excel_Files"). _
Range.AutoFilter Field:=3, Criteria1:="8 Casse entrepôt"
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Add Key _
:=Range( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files[[#All],[Emplacement]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
 
Bonjour

Vous pouvez toujours essayer les lignes ci-dessous.
sans fichier difficile de tester plus avant.
VB:
Sub Macro2()
'
' Macro2 Macro
'

'
Const SQL_Base As String = "SELECT `'2$'`.Date, `'2$'`.Emplacement, `'2$'`.Motif FROM `'2$'` AS `'2$'`;"
Dim SQL As String
Dim rep As Variant
rep = Application.InputBox("Entrez le numéro de jour désiré", "Interrogation base de données", 0, Type:=1)

If rep <> False And rep >= 1 And rep <= 31 Then SQL = Replace(SQL_Base, "2", CStr(rep))

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Users\Gravina.A\Desktop\test pour connexion\Suivi mouvements stock\2020\AA.xlsm;DefaultDir=C:\Users\Grav" _
), Array( _
"ina.A\Desktop\test pour connexion\Suivi mouvements stock\2020;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("$A$3")).QueryTable
.CommandText = Array(SQL)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files"
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-27
ActiveSheet.ListObjects("Tableau_Lancer_la_requête_à_partir_de_Excel_Files"). _
Range.AutoFilter Field:=3, Criteria1:="8 Casse entrepôt"
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Add Key _
:=Range( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files[[#All],[Emplacement]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
905
Réponses
2
Affichages
2 K
Retour