Pb Chargement de fichier

gds35

gds35

XLDnaute Impliqué
Bonjour a tous mes AMIS du Forums et Bon WE

J’ai un soucis , je veux créer un fichier stat qui reprends certaines données des années antérieures
Elles sont stockées sur une clé USB avec pour chaque années un répertoire se nommant :
0506 – 0607- 0708- ……. Allant jusqu’à 1011 , dans lequel se trouve un fichier BC.xls correspondant
aux résultat de chaque exercice. (le nom des répertoires est en dur dans une feuille PARAM du fichier
StatHC j’ai une autre feuille nommée DONNEES dans laquelle je veux recopier les données nécessaire au traitement
De mes stats . j’ai construit ce code :
Sub ChargeDonnees()
'
Dim Chemin As String ' CHEMIN POUR CHARGEMENT FICHIER BC
Dim i As Integer ' N° DE LIGNE DE L'EXERCICE DS FEUILLE PARAM
Dim Rep As String ' REPERTOIRE DANS E: SAUVEGARDE ANNUELLE
Dim Rep1 As String ' = A REP POUR TEST SI REPERTOIRE EXISTANT
Dim Ex As String ' VALEUR DE L'EXERCICE SELECTIONNE DS FEUILLE PARAM
'
i = 1
'
CHARGE:
'
' CONSTITUTION DU NOM DU REPERTOIRE
' ET DU CHEMIN DE CHARGEMENT DU FICHIER BC
'
Sheets("PARAM").Select
Ex = Range("A" & i).Value
Rep = "E:\" & Ex

MsgBox Rep
Rep1 = Dir(Rep, vbDirectory)
MsgBox Rep1
'
' TESTER SI LE REPERTOIRE EXISTE
'
If Rep1 = "" Then
GoTo TRT
Else
Chemin = Rep & "\" & "BrouillardCaisse.xls"
MsgBox Chemin
'
Workbooks.Open Filename:=(Chemin)
Sheets(14).Select 'RECAPAN du BC
Range("A10:K22").Select
Selection.Copy
Windows("StatsHC.xls").Activate
Sheets("DONNEES").Select
'
' RECHERCHE DE LA PREMIERE CELLULE VIDE
'
Lign = Range("A65536").End(xlUp).Row + 1
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("BrouillardCaisse.xls").Activate
Sheets("09").Select
Application.DisplayAlerts = False
DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
'
i = i + 1
GoTo CHARGE
'
End If
'
TRT:
'
MsgBox " FICHIER CHARGES "

End Sub
Lors du chargement des données de l’Ex 0506 tous est ok , mais lorsque je veux charger
Les données de l’ex 0607 mes données de 0506 sont écrasées par celles de l’ex 0607.
Or je veux avoir en ligne les résultats des 3 exercices pour traiter.
Ou est mon ERREUR ???? dans ce code ????
Merci de m’aider . GDS35
D'autre part pour ne + embeter le Forum lors d'un Pb résolu comment chargé le tags "PB Résolu" je n'ai ss doute jamais et en suis confus
 
Trier par date Trier par votes
K

kjin

XLDnaute Barbatruc
Re : Pb Chargement de fichier

Bonjour,
Essaie peut être comme ça, en modifiant les lignes bleues
Code: 
Sub ChargeDonnees()
'
Dim Chemin As String ' CHEMIN POUR CHARGEMENT FICHIER BC
Dim i As Integer ' N° DE LIGNE DE L'EXERCICE DS FEUILLE PARAM
Dim Rep As String ' REPERTOIRE DANS E: SAUVEGARDE ANNUELLE
Dim Rep1 As String ' = A REP POUR TEST SI REPERTOIRE EXISTANT
Dim Ex As String ' VALEUR DE L'EXERCICE SELECTIONNE DS FEUILLE PARAM
'
i = 1
'
CHARGE:
'
' CONSTITUTION DU NOM DU REPERTOIRE
' ET DU CHEMIN DE CHARGEMENT DU FICHIER BC
'
Sheets("PARAM").Select
Ex = Range("A" & i).Value
Rep = "E:\" & Ex

MsgBox Rep
Rep1 = Dir(Rep, vbDirectory)
MsgBox Rep1
'
' TESTER SI LE REPERTOIRE EXISTE
'
If Rep1 = "" Then
GoTo TRT
Else
Chemin = Rep & "\" & "BrouillardCaisse.xls"
MsgBox Chemin
'
Workbooks.Open Filename:=(Chemin)
[COLOR="Blue"]Sheets(14).Range("A10:K22").Copy 'RECAPAN du BC
Windows("StatsHC.xls").Activate
With Sheets("DONNEES")
'
' RECHERCHE DE LA PREMIERE CELLULE VIDE
'
Lign = Range("A65536").End(xlUp).Row + 1
.Range("A" & Lign).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End with[/COLOR]
Windows("BrouillardCaisse.xls").Activate
Sheets("09").Select
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
'
i = i + 1
GoTo CHARGE
'
End If
'
TRT:
'
MsgBox " FICHIER CHARGES "

End Sub
A+
kjin
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Pb Chargement de fichier

Re,
Je comprends pas comment la boucle s'arrête (si j'ai compris) ou si c'est toi qui le fait manuellement.
J'ai juste mis une boucle Do/loop t'envoie un message (ça commence à faire beaucoup de message mais bon...) lorsque le répertoire n'existe pas et s'arrête lorsque Ex est vide (à priori valeurs des cellules de la colonne A)
A+
kjin
Code: 
Sub ChargeDonnees()
Dim Chemin As String ' CHEMIN POUR CHARGEMENT FICHIER BC
Dim i As Integer ' N° DE LIGNE DE L'EXERCICE DS FEUILLE PARAM
Dim Rep As String ' REPERTOIRE DANS E: SAUVEGARDE ANNUELLE
Dim Rep1 As String ' = A REP POUR TEST SI REPERTOIRE EXISTANT
Dim Ex As String ' VALEUR DE L'EXERCICE SELECTIONNE DS FEUILLE PARAM

i = 1
Do
    Ex = Sheets("PARAM").Range("A" & i).Value
    Rep = "E:\" & Ex

    MsgBox Rep
    Rep1 = Dir(Rep, vbDirectory)
    MsgBox Rep1
    
    'TESTER SI LE REPERTOIRE EXISTE
        If Rep1 = "" Then
        MsgBox "le fichier" & Rep1 & "n'existe pas !"
        End if
        Chemin = Rep & "\" & "BrouillardCaisse.xls"
        MsgBox Chemin
        Workbooks.Open Filename:=(Chemin)
        Sheets(14).Range("A10:K22").Copy 'RECAPAN du BC
        Windows("StatsHC.xls").Activate
            With Sheets("DONNEES")
            'RECHERCHE DE LA PREMIERE CELLULE VIDE
            Lign = Range("A65536").End(xlUp).Row + 1
            .Range("A" & Lign).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                        xlNone, SkipBlanks:=False, Transpose:=False
            End With
        
        Windows("BrouillardCaisse.xls").Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
        
        i = i + 1

Loop Until Ex = ""

MsgBox " FICHIER CHARGES "

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
gds35

gds35

XLDnaute Impliqué
Re : Pb Chargement de fichier

Salut KJIN ,

une chose Me trouble pourquoi le point :
Lign = Range("A65536").End(xlUp).Row + 1
.Range("A" & Lign).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
. Range Pige pas

A+ GDS35
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Pb Chargement de fichier

Re, Bonjour Roland
Merci Roland pour la précision
Gds, la variable Ex n'étant pas réinitialisée à passage cycle, il faut tester la valeur de ("A" & i) et non de Ex
Par ailleurs, il n'y avait pas d'erreur sur la MsgBox, mais je n'avais pas testé
J'ai désactivé le rafraichissement d'écran, à toi de voir si c'est utile
A+
kjin
Code: 
Sub ChargeDonnees()
Dim Chemin As String ' CHEMIN POUR CHARGEMENT FICHIER BC
Dim i As Integer ' N° DE LIGNE DE L'EXERCICE DS FEUILLE PARAM
Dim Rep As String ' REPERTOIRE DANS E: SAUVEGARDE ANNUELLE
Dim Rep1 As String ' = A REP POUR TEST SI REPERTOIRE EXISTANT
Dim Ex As String, trouv As Boolean ' VALEUR DE L'EXERCICE SELECTIONNE DS FEUILLE PARAM

i = 1
Do
    Ex = Sheets("PARAM").Range("A" & i).Value
    Rep = "E:\" & Ex
    MsgBox Rep
    Rep1 = Dir(Rep, vbDirectory)
    MsgBox Rep1
    
    'TESTER SI LE REPERTOIRE EXISTE
        If Rep1 = "" Then
        MsgBox "le fichier" & Rep1 & "n'existe pas !"
        Else

        Chemin = Rep & "\" & "BrouillardCaisse.xls"
        MsgBox Chemin
        Application.ScreenUpdating = False
        Workbooks.Open Filename:=(Chemin)
        Sheets(1).Range("A10:K22").Copy 'RECAPAN du BC
        Windows("StatsHC.xls").Activate
            With Sheets("DONNEES")
            'RECHERCHE DE LA PREMIERE CELLULE VIDE
            Lign = Range("A65536").End(xlUp).Row + 1
            .Range("A" & Lign).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                                xlNone, SkipBlanks:=False, Transpose:=False
            End With
        
        Windows("BrouillardCaisse.xls").Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
        End If
    i = i + 1

Loop Until Sheets("PARAM").Range("A" & i) = ""
Application.ScreenUpdating = True
MsgBox " FICHIER CHARGES "

End Sub
 
Vote positif 0 Vote négatif
gds35

gds35

XLDnaute Impliqué
Re : Pb Chargement de fichier

Merci mon Ami , mais le code corrige par KJIN , ne fonctionne pas mes différentes MsgBox sont la pour suivre l'évolution du chemin du répertoire. et ma MsgBox Rep1 est a blanc donc je degage a la fin du code .
Voila le Code de notre AMI KJIN modifié selon ces conseil :
Sub ChargeDonnees()
'
Dim Chemin As String ' CHEMIN POUR CHARGEMENT FICHIER BC
Dim i As Integer ' N° DE LIGNE DE L'EXERCICE DS FEUILLE PARAM
Dim Rep As String ' REPERTOIRE DANS E: SAUVEGARDE ANNUELLE
Dim Rep1 As String ' = A REP POUR TEST SI REPERTOIRE EXISTANT
Dim Ex As String ' VALEUR DE L'EXERCICE SELECTIONNE DS FEUILLE PARAM
'
i = 1
'
CHARGE:
'
' CONSTITUTION DU NOM DU REPERTOIRE
' ET DU CHEMIN DE CHARGEMENT DU FICHIER BC
'
Sheets("PARAM").Select
Ex = Range("A" & i).Value
Rep = "E:\" & Ex

MsgBox Rep
Rep1 = Dir(Rep, vbDirectory)
MsgBox Rep1
'
' TESTER SI LE REPERTOIRE EXISTE
'
If Rep1 = "" Then
GoTo TRT
Else
Chemin = Rep & "\" & "BrouillardCaisse.xls"
MsgBox Chemin
'
Workbooks.Open Filename:=(Chemin)
'Sheets(14).Select 'RECAPAN du BC
Sheets(14).Range("A10:K22").Copy 'RECAPAN du BC
Windows("StatsHC.xls").Activate
With Sheets("DONNEES")
'Range("A10:K22").Select
'Selection.Copy
'Windows("StatsHC.xls").Activate
'Sheets("DONNEES").Select
'
' RECHERCHE DE LA PREMIERE CELLULE VIDE
'
Lign = Range("A65536").End(xlUp).Row + 1
.Range("A" & Lign).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With
'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("BrouillardCaisse.xls").Activate
Sheets("09").Select
Application.DisplayAlerts = False
DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
'
i = i + 1
GoTo CHARGE
'
End If
'
TRT:
'
MsgBox " FICHIER CHARGES "

'
End Sub

J'espère qu'il le verra aussi je ne voudrais pas le vexé , vs êtes tellement sympas A+
Je reitère ma demande : comment mettre le flag pb résolu quand les AMIS mon fourni un code super qui fonctionne ?
 
Vote positif 0 Vote négatif
gds35

gds35

XLDnaute Impliqué
Re : Pb Chargement de fichier

Merci à Vous ROLAND et KJin , pour vos précieux conseils , ainsi qu'à tout le Forum, Je testerais demain car ce soit GDS35 fait la NouNou avec ses p'tit Choun !!!!!! et il va être occupé !!!!! A+ Bonne soirée GDS35
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Pb Chargement de fichier

Re,
Désolé il y avait encore une erreur sur le nom de la feuille où se trouvent les données à importer (voir la ligne bleue du code) néanmoins je ne comprends pas où se situe ton problème :
J'ai supposé le nom des répertoires dans les cellule A1 et suivantes de la feuille "PARAM" du classeur "StatsHC.xls"
La macro que je t'ai proposé
1 - boucle sur ces cellules pour récupérer le nom du répertoire
2 - Si le répertoire n'existe pas --> message --> puis passe à la cellule suivante
2 - ouvre le classeur "BrouillardCaisse.xls" copie les lignes A10:K22 de la feuille14
3 - colle la plage à la dernière ligne de la feuille "DONNEES" du classeur "StatsHC.xls"
4 - ferme le classeur "BrouillardCaisse.xls"
5 - passe à la cellule suivante
La boucle continue tant qu'elle ne rencontre pas une cellule vide.
Voili
Code: 
Sub ChargeDonnees()
Dim Chemin As String ' CHEMIN POUR CHARGEMENT FICHIER BC
Dim i As Integer ' N° DE LIGNE DE L'EXERCICE DS FEUILLE PARAM
Dim Rep As String ' REPERTOIRE DANS E: SAUVEGARDE ANNUELLE
Dim Rep1 As String ' = A REP POUR TEST SI REPERTOIRE EXISTANT
Dim Ex As String ' VALEUR DE L'EXERCICE SELECTIONNE DS FEUILLE PARAM

i = 1
Do
    Ex = Sheets("PARAM").Range("A" & i).Value
    Rep = "E:\" & Ex
    MsgBox Rep
    Rep1 = Dir(Rep, vbDirectory)
    MsgBox Rep1
    
    'TESTER SI LE REPERTOIRE EXISTE
        If Rep1 = "" Then
        MsgBox "le fichier" & Rep1 & "n'existe pas !"
        Else

        Chemin = Rep & "\" & "BrouillardCaisse.xls"
        MsgBox Chemin
        Application.ScreenUpdating = False
        Workbooks.Open Filename:=(Chemin)
        Sheets([COLOR="Blue"]14[/COLOR]).Range("A10:K22").Copy 'RECAPAN du BC
        Windows("StatsHC.xls").Activate
            With Sheets("DONNEES")
            'RECHERCHE DE LA PREMIERE CELLULE VIDE
            Lign = Range("A65536").End(xlUp).Row + 1
            .Range("A" & Lign).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                                xlNone, SkipBlanks:=False, Transpose:=False
            End With
        
        Windows("BrouillardCaisse.xls").Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
        End If
    i = i + 1

Loop Until Sheets("PARAM").Range("A" & i) = ""
Application.ScreenUpdating = True
MsgBox " FICHIER CHARGES "

End Sub
 
Vote positif 0 Vote négatif
gds35

gds35

XLDnaute Impliqué
Re : Pb Chargement de fichier

Salut KJIN , j'avais rectifier le N0 de la feuille ta description des opérations est juste.
Le seul pb c'est que la prg ne me copie rien. j'avais pensé q=e cela venait du fait que la feuille 14 etait protégée ; Je l'ai déprotégé mais mais pb rien n'est copié !!!!! j'y perd mon latin . Cordialement bon dimanche A+ Gds35
 
Vote positif 0 Vote négatif
gds35

gds35

XLDnaute Impliqué
Re : Pb Chargement de fichier

Resalut mon AMI , Je pense avoir compris le bug entre l'ex 0506 et 0708 , j'ai modifié mon prg , en ajoutant des feuilles et des USF ds l'ex 0708 et mes recap ne se retrouve pas avec le meme nom ni avec le meme n0 de feuille.
De + ds l'ex 0708 j'ai ajouté une page entete avec USF , lorque je fermer le fichier il bloque sur l'usf Acceuil. Je Cherche la solution et te tiens au courant A+ GDS35
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Pb Chargement de fichier

Bonour,
Je ne comprends pas non plus
Par contre, as tu vérifié ces paramètres
gds35 à dit:
Elles sont stockées sur une clé USB avec pour chaque années un répertoire se nommant 0506 – 0607- 0708- ……. Allant jusqu’à 1011...
Cliquez pour agrandir...
C'est le nom de tes répertoires qui doivent se situés en A1, A2, A3...de la feuille "PARAM"
gds35 à dit:
...dans lequel se trouve un fichier BC.xls....
Cliquez pour agrandir...
Là je comprends moins bien parce qu'il me semble que l'on cherche un fichier qui se nomme "BrouillardCaisse"
Sinon, essai de faire passer ton fichier avec juste quelques données
A+
kjin
 
Vote positif 0 Vote négatif
gds35

gds35

XLDnaute Impliqué
Re : Pb Chargement de fichier

Salut Mon AMI ,

Mes répertoires se trouve bien dans la feuille PARAM et se nomment 0506......
Je ne comprends pas non + , mais je une ligne total dans laquelle les cellules A & B de cette ligne sont fusionnées est-ce cela qui fait foirer la copie ?
car je tombe en erreur les cellules de destination doivent etre de longueur et .... or elle y sont.

GDS35 Cordialement
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Pb Chargement de fichier

Bonjour,
C'est tout le problème lorsque l'on a pas de fichier test
Sans doute le bug vient-il effectivement du format des cellules
En outre, j'ai relevé un l'oubli d'un "." dans le code
Encore milles excuses
Essaie peut-être comme ça

Code: 
Sub ChargeDonnees()
Dim Chemin As String ' CHEMIN POUR CHARGEMENT FICHIER BC
Dim i As Integer ' N° DE LIGNE DE L'EXERCICE DS FEUILLE PARAM
Dim Rep As String ' REPERTOIRE DANS E: SAUVEGARDE ANNUELLE
Dim Rep1 As String ' = A REP POUR TEST SI REPERTOIRE EXISTANT
Dim Ex As String ' VALEUR DE L'EXERCICE SELECTIONNE DS FEUILLE PARAM

i = 1
Do
    Ex = Sheets("PARAM").Range("A" & i).Value
    Rep = "E:\" & Ex
    MsgBox Rep
    Rep1 = Dir(Rep, vbDirectory)
    MsgBox Rep1
    
    'TESTER SI LE REPERTOIRE EXISTE
        If Rep1 = "" Then
        MsgBox "le fichier" & Rep1 & "n'existe pas !"
        Else

        Chemin = Rep & "\" & "BrouillardCaisse.xls"
        MsgBox Chemin
        Application.ScreenUpdating = False
        Workbooks.Open Filename:=(Chemin)
        Sheets(14).Range("A10:K22").Copy 'RECAPAN du BC
        Windows("StatsHC.xls").Activate
            With Sheets("DONNEES")
            'RECHERCHE DE LA PREMIERE CELLULE VIDE
            Lign = .Range("A65536").End(xlUp).Row + 1 'ici le point qui manquait
            .Range("A" & Lign).PasteSpecial Paste:=xlAll, Operation:= _
                                xlNone, SkipBlanks:=False, Transpose:=False
            End With
        
        Windows("BrouillardCaisse.xls").Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
        End If
    i = i + 1

Loop Until Sheets("PARAM").Range("A" & i) = ""
Application.ScreenUpdating = True
MsgBox " FICHIER CHARGES "

End Sub
A+
kjin
 
Vote positif 0 Vote négatif
gds35

gds35

XLDnaute Impliqué
Re : Pb Chargement de fichier

Salut KJIN , avec mes 59 printemps qui arrivent , ma vue devient basse !!!!! je n'avais pas vu le point manquant , cela fonctionne superbement bien pour les EX 0506 et 0708 , mais depuis j'ai bossé sur ce Prg en 07 et la feuille 14 en 0708 est devenu la feuille 16 pour les EX suivants , si bien que maintenant les résultats sont débiles à partir de cette date , je vais faire un test pour charger les 2 premiers exercices et recopier le code en changeant feuille 14 en 16 pour les suivants . Encore MILLE MERCI de ton aide précieuse qui me permets d'avancer dans ce PRG. Je te tient au courant . A+ des + cordialement GDS35. Bonne soirée
 
Vote positif 0 Vote négatif

Discussions similaires

mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
712
mouchtre
mouchtre
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
396
Nico2978
Nico2978
A
  • Question
XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint
Réponses
0
Affichages
715
Aldonanou
A
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
268
marie3107
M
E
  • Question
Microsoft 365 GetFolder et Sharepoint
Réponses
3
Affichages
753
eric72
E
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
334
loreak
L
N
  • Question
XL 2016 Macro chargement liste arborescence, copier coller fichiers
Réponses
9
Affichages
525
Nermal64
N
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
345
marie3107
M
P
  • Question
Microsoft 365 Problème lors de la création d'un fichier
Réponses
4
Affichages
302
ChTi160
ChTi160
T
  • Question
Microsoft 365 Ouvrir un fichier en fonction de sa date
Réponses
1
Affichages
231
sylvanu
sylvanu

Membres actuellement en ligne

4 membres et 36 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
313 769
Messages
2 102 234
Membres
108 181
dernier inscrit
Chr1sD