Importer donnée vers un autre dossier

Bonsoir,J’espère que tu vas bien. Merci encore pour la dernière fois.
J’essaie de rédiger un code pour importer des données depuis un fichier Excel A.
Le souci, c’est que je reçois plusieurs fois le même fichier A, mais avec des dates et des valeurs différentes, par e-mail.
J’ai créé un dossier pour les stocker sur bureau.
Je voudrais donc que mon code (le module 3) parcoure tous les fichiers présents dans ce dossier, et n’importe que les données d'un fichier A vers production si la date du fichier correspond à celle présente dans mon fichier de production.

Peux-tu corriger cela pour moi ?

Salut,

Je m'étais penché sur ton problème il y a quelques jours déjà, mais j'avais trouvé tes explications et tes fichiers-exemples peu clairs et avais rapidement abandonné.

Voyant que personne ne t'a encore répondu, j'ai repris ton problème sous la loupe.

Je ne me suis intéressé qu'à la partie qui permet de passer en revue des fichiers, de les ouvrir, éventuellement de les exploiter, puis de les refermer.

Selon moi, si le ‘’chemin’’ est correctement indiqué, il n’y a qu’un seul problème à corriger dans ton code, selon l’extrait ci-dessous :

' CORRECTION
feuilleProduction.Range("B" & i).PasteSpecial xlPasteValues ' Zone de collage
''feuilleProduction.Range("B" & i &).PasteSpecial xlPasteValues ' Zone de collage

Concernant le ‘’chemin’’, j’ai compris que tu avais remplacé ton chemin à toi par ce mot ‘’chemin’’ uniquement pour la démo sur le Forum.

De mon côté, comme tu peux le constater dans le fichier ci-joint, j’ai placé ce fichier de base dans un dossier quelconque et les ‘’Fichiers A’’ – ceux à traiter – dans un sous-dossier de ce dossier quelconque, nommé ''Fichiers à traiter''. D'où mon chemin :

cheminDossier = ThisWorkbook.Path & "\Fichiers à traiter\"

Il me semble que bien d'autres choses pourraient être modifiées et/ou améliorées, mais sans comprendre réellement comment fonctionne ton système - notamment car tu n'as pas suffisamment de données en place dans tes fichiers-exemples afin de constater comment ça fonctionne - c'est difficile d'en dire plus.

Cordialement.

bonjour Lolifairy, salut Yvouille,

je pense que les cellules fusionnées du fichier "A.xls" causent le problème majeur. Je ne sais pas si tous vos fichiers sont pareils ?

Maintenant, je lis la plage du fichier "A.xls" dans une matrice et puis je la colle dans le fichier principale.

Le code qui se trouvait dans le module était l’un de mes anciens code. Je l’ai modifié pour l’adapter à mes besoins actuels, mais il ne fonctionne pas correctement.

Désormais, je ne souhaite plus utiliser de chemins d’accès codés et de date debut et fin. Je veux pouvoir sélectionner moi-même les fichiers Excel (.xls, .xlsx,) à l’aide d’un sélecteur de fichiers .

Je ne veux plus que le code ouvre automatiquement tous les fichiers Excel du dossier avant de copier les cellules. Je souhaite simplement choisir un ou plusieurs fichiers, puis copier uniquement les cellules désirées à partir du fichier que j’ai sélectionné.

Sub Importer1()

Dim cheminDossier As String
Dim nomFichier As String
Dim classeurA As Workbook
Dim feuilleA As Worksheet
Dim feuillePuit1 As Worksheet

Dim dateDebut As Date, dateFin As Date, dateRecherche As Date
Dim dateDansFichierA As Date
Dim ligne As Long
Dim donneesCopiees As Boolean

Application.ScreenUpdating = False
Application.DisplayAlerts = False

dateDebut = InputBox("Entrez la **date de début** (jj/mm/aaaa)", "Date début")
If Not IsDate(dateDebut) Then MsgBox "Date de début invalide !": Exit Sub

dateFin = InputBox("Entrez la **date de fin** (jj/mm/aaaa)", "Date fin")
If Not IsDate(dateFin) Then MsgBox "Date de fin invalide !": Exit Sub

If dateDebut > dateFin Then MsgBox "La date de début dépasse la date de fin !": Exit Sub

Set feuillePuit1 = ThisWorkbook.Sheets("P1")

cheminDossier = "C:\Users\HP
' Parcours de chaque date dans la plage
For dateRecherche = dateDebut To dateFin
donneesCopiees = False

' Recherche de la ligne correspondant à la date dans la feuille "P1"
ligne = 7
Do While feuillePuit1.Cells(ligne, 1).Value <> ""
If IsDate(feuillePuit1.Cells(ligne, 1).Value) Then
If DateValue(feuillePuit1.Cells(ligne, 1).Value) = dateRecherche Then Exit Do
End If
ligne = ligne + 1
Loop

' Si la date n'existe pas
If feuillePuit1.Cells(ligne, 1).Value = "" Then
MsgBox "? La date " & Format(dateRecherche, "dd/mm/yyyy") & " n'existe pas dans la feuille P1.", vbExclamation
GoTo ContinueLoop
End If

' Parcours des fichiers du dossier
nomFichier = Dir(cheminDossier & "*.xls*")
Do While nomFichier <> ""
Set classeurA = Workbooks.Open(cheminDossier & nomFichier, ReadOnly:=True)
Set feuilleA = classeurA.Sheets(1)

If IsDate(feuilleA.Range("V4").Value) Then
dateDansFichierA = DateValue(feuilleA.Range("V4").Value)

If dateDansFichierA = dateCourante Then
' Copie des données
feuillePuit1.Cells(ligne, 2).Value = feuilleA.Range("D47:E47").Value
feuillePuit1.Cells(ligne, 3).Value = feuilleA.Range("H47").Value
feuillePuit1.Cells(ligne, 4).Value = feuilleA.Range("J47").Value
feuillePuit1.Cells(ligne, 5).Value = feuilleA.Range("K47").Value
feuillePuit1.Cells(ligne, 6).Value = feuilleA.Range("L47").Value
feuillePuit1.Cells(ligne, 7).Value = feuilleA.Range("M47").Value
feuillePuit1.Cells(ligne, 8).Value = feuilleA.Range("O47:P47").Value
feuillePuit1.Cells(ligne, 9).Value = feuilleA.Range("Q47:R47").Value
feuillePuit1.Cells(ligne, 10).Value = feuilleA.Range("S47").Value
feuillePuit1.Cells(ligne, 11).Value = feuilleA.Range("T47").Value
feuillePuit1.Cells(ligne, 12).Value = feuilleA.Range("U47:V47").Value
feuillePuit1.Cells(ligne, 13).Value = feuilleA.Range("W47:X47").Value
feuillePuit1.Cells(ligne, 14).Value = feuilleA.Range("Y47:Z47").Value
feuillePuit1.Cells(ligne, 15).Value = feuilleA.Range("AA47").Value
feuillePuit1.Cells(ligne, 16).Value = feuilleA.Range("AB47").Value
feuillePuit1.Cells(ligne, 17).Value = feuilleA.Range("AC47").Value
feuillePuit1.Cells(ligne, 18).Value = feuilleA.Range("AD47:AE47").Value
feuillePuit1.Cells(ligne, 19).Value = feuilleA.Range("AG47:AH47").Value
feuillePuit1.Cells(ligne, 20).Value = feuilleA.Range("AI47").Value


donneesCopiees = True
MsgBox "? Données importées pour le " & Format(dateRecherche, "dd/mm/yyyy") & " depuis : " & nomFichier
classeurA.Close SaveChanges:=False
Exit Do
End If
End If

classeurA.Close SaveChanges:=False
nomFichier = Dir
Loop

If Not donneesCopiees Then
MsgBox "? Aucune donnée trouvée pour la date : " & Format(Date, "dd/mm/yyyy")
End If

ContinueLoop:
Next dateRecherche

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "? Importation terminée pour toutes les dates."

End Sub

re,

un début de réponse dans la macro "importer1" et seulement pour sélectionner vos fichiers (eventuellement multiselect). Si cela est trop lent, il faut le dire

merci mais il y a probleme quand je lance le code. il ouvre d'abord tous les fichiers excel qui se trouve dans mon dossier avant de copier les cellules demandées

re,

commençons avec un seul fichier avec ce "multiselect:=false"

FileToOpen = Application.GetOpenFilename(Title:="Choississez vos fichiers en utilisant le " & Chr(34) & "CTRL" & Chr(34) & "-bouton", FileFilter:="Excel Files (" & sFilterFichiers & "," & sFilterFichiers, MultiSelect:=True)

Il vous propose bien vos fichiers voulu et si vous avez sélectionné un fichier le premier élément de la matrice "FileToOpen" contient le nom de votre fichier.

modifier autrement le msgbox

MsgBox "jusqu'ici votre question concernant sélectionner moi-même ..." & vbLf & "le reste je n'ai pas encore bien lu" & vbLf & vbLf & Join(filetoopen, vbLf)

Y-a-t-il beaucoup de fichiers dans ce dossier ? Autrement un userform pour sélectionner plus facilement, les fichiers, ils ont le même préfix ou suffix ?

les dossiers contiennent plusieurs fichiers excel et ils ont le même suffixe

cà fonctionne avec "multiselect:=false" pour 1 fichier jusqu'au moment oùla macro s'arrête avec "end" ?