Copier-coller de donnée sur un fichier du disk dur C
Bonjour à tous
Merci pour toutes les fois que vous m'avez aider à solutionner mes soucis.
J'ai le code ci-dessou qui me permet de copier des données et des les coller sur une feuille du meme fichier.
Je veux cette fois ci que les données copier soient coller sur la feuil1 du fichier SESAME qui se trouve sur le disque dur C.
Comment faire pour trouver le chemin d'acces du fichier dans C?
Sub COPIER_SESAME()
'Déclaration des variables
Dim b, c, d, e, f As String
'Sélection de la valeur de !DONNE E10 et mise en variable
Sheets("DONNE").Select
'verification des cellules à copier
If Range("B13").Value = "" Then
MsgBox ("Manque le nom et le prenom")
ElseIf Range("B28").Value = "" Then
MsgBox ("manque le téléphone")
ElseIf Range("B42").Value = "" Then
MsgBox ("Manque le N° du compte")
ElseIf Range("A56").Value = "" Then
MsgBox ("Le client ne veut pas de carte")
ElseIf Application.WorksheetFunction.CountIf(Sheets("STATSESAME").Range("c11:c" & Sheets("STATSESAME").Range("c65536").End(xlUp).Row), Range("B42").Value) > 0 Then
MsgBox ("Ce compte est déjà présent dans la feuille STATSESAME")
Else
'copie des cellules
b = Range("B42").Value 'nom_prenom
c = Range("A56").Value 'Type produit
d = Range("b28").Value 'téléphone
e = Range("B13").Value 'n° compte
f = Range("A55").Value 'Réf pièce
'selection de la feuille de destination
Sheets("STATSESAME").Select
'selection de la première cellule de destination
Range("c11").Select
'vérification de la cellule de destination
If ActiveCell.Value = "" Then 'si la cellule est vide, on colle
ActiveCell = b
ActiveCell.Offset(0, 1) = e
ActiveCell.Offset(0, 2) = d
ActiveCell.Offset(0, 3) = c
ActiveCell.Offset(0, 4) = f
Exit Sub
Else 'la cellule n'est pas vide
'on boucle tant que la cellule de destination n'est pas vide
Do While ActiveCell.Value <> ""
'selection de la cellule du dessous
ActiveCell.Offset(1, 0).Select
'si la cellule est vide, on colle
If ActiveCell.Value = "" Then
ActiveCell = b
ActiveCell.Offset(0, 1) = e
ActiveCell.Offset(0, 2) = d
ActiveCell.Offset(0, 3) = c
ActiveCell.Offset(0, 4) = f
Exit Sub
Else
'selection de la cellule du dessous
ActiveCell.Offset(1, 0).Select
End If
Loop 'on boucle tant que la cellule n'est pas vide
End If
'si la cellule est vide, fin de la boucle, et on colle
ActiveCell = b
ActiveCell.Offset(0, 1) = e
ActiveCell.Offset(0, 2) = d
ActiveCell.Offset(0, 3) = c
ActiveCell.Offset(0, 4) = f
End If
End SubBonjour,
Tu veux copier sur le classeur <SESAME .xls> qui se trouve sur C mais tu ne sais pas où ?
Si oui, c'est possible mais la recherche risque de prendre un certain temps !
Tu dis
A+
Slt Lermite
Merci de vous interessé à mon fichier. c'est bien ce que je veux faire.
Re,
Il y a deux possibilités,
1°) Ouvrir un explorateur de fichier ou l'utilisateur "montre" où se trouve le fichier.
2°) Faire un balayage du DD comme une recherche avec l'explorateur ?. C'est cette solution qui risque de prendre du temps.
Si 2..
a) Aucune idée d'un répertoire cible ?
b) Exclure les répertoires systèmes ?, dans ces répertoires il y a énormément de fichiers.
Tu dis.
A+
Bonsoir le fil, zombe
tu peux utiliser
Sub TestRechercheAvecDossierDépart()
ChercheFichier "C:\", "sesame.xls", Retour
MsgBox Retour
End Sub
Sub ChercheFichier(dossierDépart, nomFichier, Retour)
'renvoie dans la variable "retour" le chemin complet de "nomFichier"
Dim fso, Fichiers, Fichier, Dossier, Racine, SousDossiers
' Vérifier l'anti-slash de fin
If Right(dossierDépart, 1) <> "\" Then dossierDépart = dossierDépart & "\"
On Error Resume Next ' En cas d'erreur
Set fso = CreateObject("Scripting.FileSystemObject")
Set Racine = fso.GetFolder(dossierDépart)
Set Fichiers = Racine.Files
For Each Fichier In Fichiers
If UCase(Fichier.Name) = UCase(nomFichier) Then
Retour = Fichier.Path
End If
Next
Set SousDossiers = Racine.subfolders
For Each Dossier In SousDossiers
ChercheFichier Dossier, nomFichier, Retour
Next
On Error GoTo 0
End SubATTENTION ça peut être très long
Comme le dis lermite il faudra peut-être exclure les dossiers système
A+
Merci pour vos élements de réponse.
Je partage la machine avec un autre utilisateur.
Chacun de nous ayant sa session.
Nous devrons copier-coller des donner des un même fichier donc j'ai pensé au disq C.
Dans notre cas, il n'ya pas beaucoup de dossier (maxi 10). Mais si vous avez d'autre proposition qui puisse répondre à mon besoin, je suis partant.
BrunoM45 : je n'arrive pas à exploiter ton code. j'avais posté déjà un code avec lequel je voulais qu'on adazpte de sorte que le meme code puisse copier-coller dans C. comment utiliser votre code avec le mien pour que ca fonctionne?
Encore merci pour le soutien
Bonjour zombe et bruno.
J'ai examiner le code que tu propose mais il n'est pas heuu fort optimiser
1°) Méme quand la recherche à abouti, il continue à tout scanner jusqu'au dernier iota. Environ 4 minutes pour scanner mon PC
2°)iI scanne la corbeille où se trouve souvent des versions précédentes.
3°) Ne libère pas la mémoire, ce qui pourrait (surtout dans ton approche) occasionner un débordement de la pille.
4°) L'emploi de la fonction Dir serait beaucoup plus judicieuse et surtout plus rapide.
5°) Comme tu passe en revue TOUT les fichiers, le fait de supprimer 2 fois Ubound serait un avantage, pour cela il faut mettre Option Compare Text, mais ce n'est pas nécessaire avec Dir.
Enfin bon, cette petite mise au point pour te permettre d'avancer.
Zombe -> Copie le code ci-dessous dans un module général, Module1 par exemple.
Public Fichier As String
Public Sortie As Boolean
Sub AjoutRep(Chem As String, Cle As String)
Dim Rep, sRp, Obj, sRep, sR2
Dim sCle As String
Dim NbsR As Integer, S As String
Chem = Slach(Chem)
If Dir(Chem & Cle) <> "" Then Fichier = Chem & Cle: Sortie = True: Goto Passe2
If Sortie Then GoTo Passe2
Set Obj = CreateObject("Scripting.FileSystemObject")
Set Rep = Obj.GetFolder(Chem)
If Left(Rep.Name, 1) = "$" Then GoTo Passe2
Set sRep = Rep.subfolders
For Each sRp In sRep
S = UCase(sRp.Name)
'Elimine les répertoires système
If Left(S, 1) = "$" Or S = "WINDOWS" Or sRp.Attributes = 19 _
Or Left(S, 6) = "SYSTEM" Or Left(S, 7) = "PROGRAM" Or Left(S, 4) = "USER" _
Or Left(S, 6) = "DRIVER" Or Left(S, 5) = "TOOLS" Then GoTo Passe
On Error Resume Next
Set sR2 = sRp.subfolders
NbsR = sR2.Count
sCle = Slach(sRp.Path)
If Dir(sCle & Cle) <> "" Then Fichier = sCle & Cle: Sortie = True: GoTo Passe2
If NbsR > 0 Then
AjoutRep sCle, Cle
If Sortie Then GoTo Passe2
End If
Passe:
Next
Passe2:
Set Obj = Nothing
Set Rep = Nothing
Set sRep = Nothing
Set sR2 = Nothing
End Sub
Function Slach(C As String) As String
Slach = C & IIf(Right(C, 1) = "\", "", "\")
End FunctionLes noms ne correspondent pas au contexte mais c'est une sub perso que j'ai légèrement adapter.
Tu demande comment te servir de la procédure : Suffit simplement d'appeler la fonction avec le nom du fichier que tu cherche, suivant ce que tu dis...
Sortie = False
AjoutRep "C:\", "SESAME .xls" 'adapter l'extention suivant ta version.
'En ensuite
WorkBook(Fichier).open ' tout simplement.J'ai fait un test et ça à pris 0,53 secondes mais évidement ça dépend de où se trouve le classeur.
A+
Salut Lermite
Vraiment merci pour ce que ta dejà fait. c'est magnifique même si je comprend pas trop.
Excuse si je demande encore plus. A vrai dire suis trop doué dans les macros. Souvent je m'en sors avec les macros qu'on me propose mais la tienne n'est pas pour un noviste en vba comme moi(rire). Pouvez-vous me joindre votre fichier test afin que je voie la logique.
Je vois que vous maitrisez la notion des macros optimisées c'est à dire qui s'exécute rapidement et des macros dont la lecture ne facilite l'exécution. Je vous reviendrai dans un autre thème pour ça car je dois finaliser mon fichier et l'installer dans le poste des utilisateurs.
lermite a écrit :Méme quand la recherche à abouti, il continue à tout scanner jusqu'au dernier iota. Environ 4 minutes pour scanner mon PC
2°)iI scanne la corbeille où se trouve souvent des versions précédentes.
3°) Ne libère pas la mémoire, ce qui pourrait (surtout dans ton approche) occasionner un débordement de la pille.
4°) L'emploi de la fonction Dir serait beaucoup plus judicieuse et surtout plus rapide.
Pouvez-vous déjà en tenir compte (optimiser) la macro que j'avais envoyée?
merci
Re zombe,
Il y a quiproquo, ces remarques s'adresse au code proposer par Bruno.
Il y a bien quelque petite améliorations à faire dans TON code mais vraiment minime.
Mais en relisant le topic je crois que l'ont s'est égarés, répond aux questions ci-dessous ça permettra de mieux comprendre ce que tu veux.
1°) Vous êtes deux à vous servir du même classeur ?
2°) Ce classeur est où ? sur un PC, un serveur..
Tu dis.
A+
Merci pour le feedback.
OUi nous sommes deux à utiliser la machine chacun ayant sa session.
Le classeur de depart et celui ou les données doivent être collées se trouve dans un même dossier du disq dur C. mais chacun a crée un raccourci sur son bureau.
Le nom du dossier commun est SGIIOC, le classeur depart est intitulé CARTE BLANCHE et l'autre SESAME.
Le dossier, les classeurs se trouve sur un PC.
Je reste dispo pour d'autres éclaircissements.
Pour répondre à ta demande, voir TON code optimiser
Sub COPIER_SESAME()
Dim LigneVide As Long, T As Long
With Sheets("STATSESAME")
LigneVide = .[C65536].End(xlUp).Row
T = Application.WorksheetFunction.CountIf(.Range("C11:C" & LigneVide), .[B42])
End With
Sheets("DONNE").Select
'verification des cellules à copier
If T <> 0 Then
MsgBox ("Ce compte est déjà présent dans la feuille STATSESAME")
ElseIf Range("B13").Value = "" Then
MsgBox ("Manque le nom et le prenom")
ElseIf Range("B28").Value = "" Then
MsgBox ("manque le téléphone")
ElseIf Range("B42").Value = "" Then
MsgBox ("Manque le N° du compte")
ElseIf Range("A56").Value = "" Then
MsgBox ("Le client ne veut pas de carte")
Else
'copie sur la feuille de destination
With Sheets("STATSESAME")
LigneVide = .Range("C11").End(xlDown).Row + 1
.Cells(LigneVide, "C") = [B42] 'nom_prenom
.Cells(LigneVide, "D") = [A56] 'Type produit
.Cells(LigneVide, "E") = [B28] 'téléphone
.Cells(LigneVide, "F") = [B13] 'n° compte
.Cells(LigneVide, "G") = [A55] 'Réf pièce
End With
'ICI DEVRAIT COPIER LES DONNEES DANS LE CLASSEUR COMMUN
End If
End SubTu dis..
A+
Merci pour l'optimisation du code.
J'ai testé mais rien ne se colle et il n'ya pas de debogage non plus.
' ICI DEVRAIT COPIER LES DONNEES DANS LE CLASSEUR COMMUN (tu veux dire que le collage a lieu sur le classeur definit dans l'emplacement C?)
C'est également à partir de ce code que je souhaite que les données copiées soient collées sur le classeur SESAME du dossier SGIIOC dans l'emplacement C.
Pouvez-vous revoir
Mais je n'ai rien à revoir, le code optimiser fait exactement ce que l'exemple de ton premier poste fait. 8)
Ton code fonctionnait ?
Et précise...
La procédure est sur quel classeur ?
'ICI DEVRAIT COPIER LES DONNEES DANS LE CLASSEUR COMMUN
Donc copier sur C:\SGIIOC\CARTE BLANCHE.xls
Mais de quel PC, le tien ou l'autre,
L'appel d'un classeur est tout a fait différent s'il est sur ton PC ou sur un autre.
Y a t'il un serveur ?
Je n'ai pas de boule de cristal et non plus de pouvoir de divination, alors explique EN DÉTAIL, le contexte, sinon ont risque de tourner en rond encore longtemps.
Dans un premier temps fais ces macros...
Active l'éditeur de macro et fait manuellement le transfert des données sur le classeur commun
Arrête la macro et poste la.
Ensuite, tu va sur l'autre PC et tu fais la même chose et poste aussi cette macro.
Pour l'instant, les données que tu entrera dans le classeur commun n'ont pas d'importance.
Répond aux questions point par point Stp.
A+
Edit :
Pour que ce soit bien clair
Le classeur sur ton PC se nomme comment ?
Le classeur sur l'autre PC se nomme comment ?
le classeur commun se nomme comment ?
Salut Lermite
Merci pour vos éléments de réponse.
Comme vous me l'avez demandé, je vais répondre à vos questions point par point:
lermite a écrit :Ton code fonctionnait ?
Oui mon code fonctionnait bien mais j'ai revu ton code et ca marche bien donc plus de problème sur ca.
zombe a écrit :Donc copier sur C:\SGIIOC\CARTE BLANCHE.xls
C'est bien l'emplacement ou devra être copiées les données.
zombe a écrit :Mais de quel PC, le tien ou l'autre,
Il ne s'agit pas de 2 PC mais d'un seul PC que nous partageons à deux chacun ayant sa session.
zombe a écrit :Le classeur sur ton PC se nomme comment ?
Comme je l'ai dejà dis, nous partageons la même PC à deux ce qui signifie que l'utilisation n'est pas simultanée;c'est lorsque l'un de nous est absent que l'autre se connecte avec sa session.
IL y'a un classeur commun ou les données devront être copiées (CARTE BLANCHE).
zombe a écrit :le classeur commun se nomme comment ?
IL y'a également un autre classeur commun ou les données devront être collées. il est intitulé SESAME.
Je t'envoi l'enregistrement demain mais déjà vous pourrez apprécier les réponses à vos questions
Re,
Eh bien voilaaaaa
Maintenant c'est plus clair.
Plus besoin des macro demandées dans mon poste précédant.
Reste une question
Vous travailler tout les deux sur le classeur CARTE BLANCHE ? et c'est sur celui-là que ce trouve le code ?
Vous mettez les nouvelles données dans CARTE BLANCHE... ET ... SESAME
Où copier sur le classeur SESAME
Tu dis.
EDIT : Je relis ton poste précédant et j'ai un doute.. OU SE TROUVE LA MACRO
EDIT : J'ai encore un autre doute, est-ce que l'un de vous travail sur CARTE BLANCHE et l'autre sur SESAME et quand vous avez finit vos modif vous voulez sauver sur le classeur de l'autre ?
Bonjour Lermite
Merci pour tout le temps que vous m'accordez.
lermite a écrit :Vous travailler tout les deux sur le classeur CARTE BLANCHE ? et c'est sur celui-là que ce trouve le code ?
Oui c'est bien ca.
Nous voulons que les données copiées soient collées dans SESAME.
lermite a écrit :EDIT : Je relis ton poste précédant et j'ai un doute.. OU SE TROUVE LA MACRO
La macro se trouve dans un module du classeur CARTE BLANCHE.
lermite a écrit :EDIT : J'ai encore un autre doute, est-ce que l'un de vous travail sur CARTE BLANCHE et l'autre sur SESAME et quand vous avez finit vos modif vous voulez sauver sur le classeur de l'autre ?
Non, nous travaillons uniquement sur CARTE BLANCHE.
Quant on fini y'a plus rien à faire puisse qu'au fur que ouvrons les comptes à nos clients, les données sont copiées et collées sur SESAME automatiquement.
Merci
Mais alors c'est le répertoire de SESAME qu'il faut, et je suppose que tu le connais !
Si tu me dis où doivent être collées les données je termine le code.
A+
Salut
Voici l'emplacement du fichier : C:\SGIIOC\SESAME.xls
Cordialement
Suis pas encore sûr d'avoir bien compris... peut-être
Sub COPIER_SESAME()
Dim LigneVide As Long, T As Long
Sheets("DONNE").Select
'verification des cellules à copier
If Range("B13").Value = "" Then
MsgBox ("Manque le nom et le prenom")
ElseIf Range("B28").Value = "" Then
MsgBox ("manque le téléphone")
ElseIf Range("B42").Value = "" Then
MsgBox ("Manque le N° du compte")
ElseIf Range("A56").Value = "" Then
MsgBox ("Le client ne veut pas de carte")
Else
'copie sur la feuille de destination
With Workbooks("C:\SGIIOC\SESAME.xls").Open
With .Sheets("STATSESAME")
LigneVide = .[C65536].End(xlUp).Row
T = Application.WorksheetFunction.CountIf(.Range("C11:C" & LigneVide), [B42])
If T <> 0 Then
MsgBox ("Ce compte est déjà présent dans la feuille STATSESAME")
Else
LigneVide = LigneVide + 1
.Cells(LigneVide, "C") = [B42] 'nom_prenom
.Cells(LigneVide, "D") = [A56] 'Type produit
.Cells(LigneVide, "E") = [B28] 'téléphone
.Cells(LigneVide, "F") = [B13] 'n° compte
.Cells(LigneVide, "G") = [A55] 'Réf pièce
End If
End With
.Save
.Close
End With
End If
End SubTu dis.
A+
Salut Lermite
Merci pour le code que tu m'as proposé.
Je viens de le tester mais y'a débogage àce niveau :
With Workbooks("C:\SGIIOC\SESAME.xls").OpenDonc le code ne fonctionne pas.
Merci pour le coup de main ; je reste à l'écoute.