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

[GV91]

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

 

[Hasco]

Bonjour

Vous pouvez toujours essayer les lignes ci-dessous.
sans fichier difficile de tester plus avant.

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

 

[GV91]

Bonjour @Roblochon
Merci pour ta réponse, le code est top !