Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

code a modifier

14 réponses
Avatar
Cyr73
Bonjour,

voilà j'ai essayer dans tout les sens mais sans resultat,je voudrais
recherche dans c\Budgets tous les fichiers commencant par les BUD_
et effectuer une macro identique sur tout les fichiers (pour la macro je
sais faire
via l'editeur de macro)
je me suis servis du code de MichDenis comme base

Sub Test()
Dim Rg as range,Fichier as string, C as range

With Worksheets("Feuil1")
set Rg = .range("A1:A" & .Range("A65536").end(xlup).row)
End with

For each c in Rg
if c<>"" then
Fichier = dir(c & "*.*")
do while fichier <> ""
'Fichier = "Nom du fichier seulement"
"C = Chemin du fichier inscrit dans la cellule"
'le traitement de ton fichier

fichier = dir()
loop
end if
next
end sub

--
Cordialement

et avec tout mes remerciements..

4 réponses

1 2
Avatar
MichDenis
Voici ton fichier avec la macro déjà intégrée. Dans le coin supérieur gauche
j'ai ajouté un bouton "Exécution". Un clic et le travail devrait se faire...!
http://cjoint.com/?gtdVq6H6PN

La macro utilise ADO ("Microsoft activex data object 2.8 librairy")

La macro ajoutée à ton fichier : Cette façon de faire ne requiert pas
d'ouvrir les fichiers individuellement.

'----------------------------------------------
Sub MaRequêteAvecADO()

'Pour exécuter cette requête, la référence suivante doit être chargée :
'Microsoft Activex Data Object 2.8 librairy"
'Pour ce faire, barre des menus / outils / référence /
'cocher la référence indiquée dans la liste.

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim File As String, DerLig As Long
Dim Chemin As String, Nb As Long

NomFeuille = "Saisie" 'A déterminer
Chemin = "C:Budgets" 'à déterminer
Adresse = "AE5:AE10" 'où sont les données
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$" & "AE5:AE10]"

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection

Application.ScreenUpdating = False
File = Dir(Chemin & "BUD_*.*")
With ThisWorkbook.Worksheets("synthese")
DerLig = .Range("B65536").End(xlUp)(2).Row
Do While File <> ""
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;"""

Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
.Range("B" & DerLig) = File
.Range("C" & DerLig).Resize(, Nb) = Rst.GetRows
Rst.Close
Conn.Close
DerLig = DerLig + 1
File = Dir()
Loop
End With
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
Application.ScreenUpdating = True
End Sub
'----------------------------------------------







"Cyr73" a écrit dans le message de groupe de discussion
:
Voici..

http://www.cijoint.fr/cjlink.php?file=cj200906/cijhdP5zvf.xls

Merci
Avatar
Daniel.C
Bonjour.
Indépendamment de la macro de MichDenis qui permet de na pas ouvrir les
fichiers, j'ai testé ta macro avec d'autres fichiers et celle-ci
fonctionne. Le problème doit venir de tes fichiers (emplacement de la
plage à copier notamment ?)
Daniel

Voici..

http://www.cijoint.fr/cjlink.php?file=cj200906/cijhdP5zvf.xls

Merci


Avatar
MichDenis
Bonjour Daniel,

Si ton diagnostic est bon, ma macro ne fera pas mieux !
;-)


"Daniel.C" a écrit dans le message de groupe de discussion :
uCU#
Bonjour.
Indépendamment de la macro de MichDenis qui permet de na pas ouvrir les
fichiers, j'ai testé ta macro avec d'autres fichiers et celle-ci
fonctionne. Le problème doit venir de tes fichiers (emplacement de la
plage à copier notamment ?)
Daniel

Voici..

http://www.cijoint.fr/cjlink.php?file=cj200906/cijhdP5zvf.xls

Merci


Avatar
Cyr73
Bonjour,

j'ai télécharger le fichier de MichDenis, j'ai ensuite nommé ce fichier
Synthese
puis je l'ai tester et là miracle tout marche merveilleusement.
je n'ai d'autre mots que merci mais celui-ci et loin de ce que je pense.
Vous venez de m'eviter un travail laborieux et répetitif sans oublier la
manipulation
humaine qui est souvent la cause de petits soucis.....

Cordialement

Cyr73
1 2