Copie de données d'un classeur à l'autre
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
-
11 févr. 2007 à 02:45
olivier857 Messages postés 188 Date d'inscription mardi 21 décembre 2004 Statut Membre Dernière intervention 10 avril 2008 - 14 févr. 2007 à 23:48
olivier857 Messages postés 188 Date d'inscription mardi 21 décembre 2004 Statut Membre Dernière intervention 10 avril 2008 - 14 févr. 2007 à 23:48
A voir également:
- Copie de données d'un classeur à l'autre
- Récupérer données json (javascript) - Conseils pratiques -Javascript
- Base de données javascript - Conseils pratiques -Javascript
- Ebp impossible de se connecter à la base de données ✓ - Forum SQL
- Vba récupérer données d'un autre classeur sans l'ouvrir - Forum VBA Office (Excel, Word ...)
- Base de données d'un site e-commerce - Forum PHP
21 réponses
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
11 févr. 2007 à 14:01
11 févr. 2007 à 14:01
Essaie comme ceci pour voir
Sheets(Destination.txt_old_onglet.Text).Activate
Range("A1").Select
ActiveSheet.Paste
ou peut-être
Range("A1").pastespecial xlpastevalues
Range("A1").pastespecial xlpasteFormats ' au besoin
Range("A1").pastespecial xlpasteFormulas ' au besoin
MPi
Sheets(Destination.txt_old_onglet.Text).Activate
Range("A1").Select
ActiveSheet.Paste
ou peut-être
Range("A1").pastespecial xlpastevalues
Range("A1").pastespecial xlpasteFormats ' au besoin
Range("A1").pastespecial xlpasteFormulas ' au besoin
MPi
drouault
Messages postés
73
Date d'inscription
samedi 9 juillet 2005
Statut
Membre
Dernière intervention
14 août 2007
11 févr. 2007 à 15:38
11 févr. 2007 à 15:38
Et comme ça ????
Compte.Worksheets(Destination.txt_old_onglet.Text).Cells(1, 1).Select
Pierre
Compte.Worksheets(Destination.txt_old_onglet.Text).Cells(1, 1).Select
Pierre
Molenn
Messages postés
797
Date d'inscription
mardi 7 juin 2005
Statut
Membre
Dernière intervention
23 février 2011
7
11 févr. 2007 à 16:26
11 févr. 2007 à 16:26
Personnellement moi, je me refuse à utiliser les ActiveWorkbook etc quand je veux faire des copies de données d'un classeur à un autre, il suffit que je rajoute une procédure après et tout fout le camp, etc ... Je préfère de loin déclarer systématiquement les classeurs.
Pour celà, avant toute copie, j'ouvre mon classeur de destination :
Workbooks.open ("chemin du fichier\Fichier cible.xls")
(Là, moi je joue avec des variables parce que je ne veux pas que, sous prétexte qu'on change un accent dans le nom du fichier, ça ne fonctionne plus, mais chacun son truc ^^)
Ensuite, je copie les données :
Workbooks("Fichier d'origine.xls").Worksheets("Nom de la feuille").Cells.Copy
Workbooks("Fichier cible.xls").Worksheets("Nom de la feuille").Cells.pastespecial xlpastevalues
(avec les différentes options ... L'enregistreur de macro te les donnera).
Depuis que je fonctionne ainsi, je n'ai plus de pbs de copies entre mes différents classeurs, et je ne passe pas trois plombes à rechercher à quel classeur me renvoit ActiveWorkbook, etc ...
Molenn
Pour celà, avant toute copie, j'ouvre mon classeur de destination :
Workbooks.open ("chemin du fichier\Fichier cible.xls")
(Là, moi je joue avec des variables parce que je ne veux pas que, sous prétexte qu'on change un accent dans le nom du fichier, ça ne fonctionne plus, mais chacun son truc ^^)
Ensuite, je copie les données :
Workbooks("Fichier d'origine.xls").Worksheets("Nom de la feuille").Cells.Copy
Workbooks("Fichier cible.xls").Worksheets("Nom de la feuille").Cells.pastespecial xlpastevalues
(avec les différentes options ... L'enregistreur de macro te les donnera).
Depuis que je fonctionne ainsi, je n'ai plus de pbs de copies entre mes différents classeurs, et je ne passe pas trois plombes à rechercher à quel classeur me renvoit ActiveWorkbook, etc ...
Molenn
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
11 févr. 2007 à 23:32
11 févr. 2007 à 23:32
Molenn je ne suis pas sure d ebien comprendre ce que tu m'explique. Aurait tu stp un bout de code concret a me donner.
Merci
Oliv
Merci
Oliv
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Molenn
Messages postés
797
Date d'inscription
mardi 7 juin 2005
Statut
Membre
Dernière intervention
23 février 2011
7
12 févr. 2007 à 11:21
12 févr. 2007 à 11:21
Celui que je te donne est un exemple concret déjà ^^, mais je vais quand même te faire un exemple.
Je veux copier les cellules A1 à A10 de la feuille 1 de mon classeur dans les cellules B5 à B15 de la feuille 3 du classeur Test.xls situé dans le répertoire C:\Temp.
Le classeur ouvert (et dans lequel se trouve ma macro) s'appelle Démo.xls
La première chose à faire, ouvrir le fichier cible, à savoir Test.xls
C'est tout simple, le code est : Workbooks.open ("C:\Temp\Test.xls")
Ensuite, l'opération se décomposant en deux, je vais d'abord copier les cellules A1 à A10 de ma feuille 1, du classeur Démo.xls
Le code : Workbooks("Démo.xls").Worksheets("Feuille 1").Range("A1:A10").Copy
Plus qu'à coller dans le classeur Test.xls
Le code : Workbooks("Test.xls").Worksheets("Feuille 3").Range("B5:B15").Pastespecial xlpastevalues
Voilà, c'est tout.
Molenn
Je veux copier les cellules A1 à A10 de la feuille 1 de mon classeur dans les cellules B5 à B15 de la feuille 3 du classeur Test.xls situé dans le répertoire C:\Temp.
Le classeur ouvert (et dans lequel se trouve ma macro) s'appelle Démo.xls
La première chose à faire, ouvrir le fichier cible, à savoir Test.xls
C'est tout simple, le code est : Workbooks.open ("C:\Temp\Test.xls")
Ensuite, l'opération se décomposant en deux, je vais d'abord copier les cellules A1 à A10 de ma feuille 1, du classeur Démo.xls
Le code : Workbooks("Démo.xls").Worksheets("Feuille 1").Range("A1:A10").Copy
Plus qu'à coller dans le classeur Test.xls
Le code : Workbooks("Test.xls").Worksheets("Feuille 3").Range("B5:B15").Pastespecial xlpastevalues
Voilà, c'est tout.
Molenn
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
12 févr. 2007 à 22:39
12 févr. 2007 à 22:39
Bon alors je reviens à la charge car je n'arrive tjs pas à réaliser ce que je souhaite. Apparement peu importe ce que je fait sur l'un des 2 classeurs ,que ce soit l'ancien que je réouvre ou le nouveau que je crée, cela plante.
A partir du moment ou je fait "workbooks(). ..." ou "workshettes(). ..." peu importe ce que j'écrit derrière mon code plante.
Je vous redonne mon code :
If old = True Then 'Copie dans une nouvel feuille d'un classeur existant
old_ong = Destination.txt_old_onglet
old_class = Destination.txt_old_classeur
Worksheets("macro").Cells.Copy
Workbooks.Open old_class
Sheets.Add
Workbooks(old_class).ActiveSheet.Name = old_ong
Workbooks(old_class).Worksheets(old_ong).Cells.Paste
Workbooks(old_class).Worksheets(old_ong).Range("C1") = Destination.txt_type_forfait.Text
Workbooks(old_class).Worksheets(old_ong).Range("C2") = Destination.txt_date_camp.Text
Workbooks(old_class).Worksheets(old_ong).Range("C3") = Destination.txt_cdp.Text
Set classeur_cible = Workbooks(old_class)
Set feuille_cible = Workbooks(old_class).Worksheets(old_ong)
ElseIf old = False Then 'Copie dans une feuille d'un nouveau classeur
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
Worksheets("macro").Cells.Copy
Application.Workbooks.Add
ActiveWorkbook.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Workbooks(new_class).Worksheets(3).Delete
Workbooks(new_class).Worksheets(2).Delete
Workbooks(new_class).Worksheets(1).Name = new_ong
Application.DisplayAlerts = True
Workbooks(new_class).Worksheets(new_ong).Cells.Paste
Workbooks(new_class).Worksheets(new_ong).Range("C1") = Destination.txt_type_forfait.Text
Workbooks(new_class).Worksheets(new_ong).Range("C2") = Destination.txt_date_camp.Text
Workbooks(new_class).Worksheets(new_ong).Range("C3") = Destination.txt_cdp.Text
Set classeur_cible = Workbooks(new_class)
Set feuille_cible = Workbooks(new_class).Worksheets(new_ong)
End If
Voilà je ne comprend vraiment pas mon pb.
A partir du moment ou je fait "workbooks(). ..." ou "workshettes(). ..." peu importe ce que j'écrit derrière mon code plante.
Je vous redonne mon code :
If old = True Then 'Copie dans une nouvel feuille d'un classeur existant
old_ong = Destination.txt_old_onglet
old_class = Destination.txt_old_classeur
Worksheets("macro").Cells.Copy
Workbooks.Open old_class
Sheets.Add
Workbooks(old_class).ActiveSheet.Name = old_ong
Workbooks(old_class).Worksheets(old_ong).Cells.Paste
Workbooks(old_class).Worksheets(old_ong).Range("C1") = Destination.txt_type_forfait.Text
Workbooks(old_class).Worksheets(old_ong).Range("C2") = Destination.txt_date_camp.Text
Workbooks(old_class).Worksheets(old_ong).Range("C3") = Destination.txt_cdp.Text
Set classeur_cible = Workbooks(old_class)
Set feuille_cible = Workbooks(old_class).Worksheets(old_ong)
ElseIf old = False Then 'Copie dans une feuille d'un nouveau classeur
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
Worksheets("macro").Cells.Copy
Application.Workbooks.Add
ActiveWorkbook.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Workbooks(new_class).Worksheets(3).Delete
Workbooks(new_class).Worksheets(2).Delete
Workbooks(new_class).Worksheets(1).Name = new_ong
Application.DisplayAlerts = True
Workbooks(new_class).Worksheets(new_ong).Cells.Paste
Workbooks(new_class).Worksheets(new_ong).Range("C1") = Destination.txt_type_forfait.Text
Workbooks(new_class).Worksheets(new_ong).Range("C2") = Destination.txt_date_camp.Text
Workbooks(new_class).Worksheets(new_ong).Range("C3") = Destination.txt_cdp.Text
Set classeur_cible = Workbooks(new_class)
Set feuille_cible = Workbooks(new_class).Worksheets(new_ong)
End If
Voilà je ne comprend vraiment pas mon pb.
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
12 févr. 2007 à 23:04
12 févr. 2007 à 23:04
Essaie en utilisant 2 variables, disons Origine et Destination As Workbook (ou As window)
Quand tu es dans ton fichier d'origine, tu écris
Set Origine = ActiveWorkBook
Lorsque tu crées un nouveau WorkBook, tu te retrouves dans celui-ci par défaut, donc
Set Destination = ActiveWorkbook
Et tu peux donc te promener d'un à l'autre en les appelant par leurs nouveaux noms
Origine.Activate
Cells.copy
Destination.Activate
Range("A1").Pastespecial
MPi
Quand tu es dans ton fichier d'origine, tu écris
Set Origine = ActiveWorkBook
Lorsque tu crées un nouveau WorkBook, tu te retrouves dans celui-ci par défaut, donc
Set Destination = ActiveWorkbook
Et tu peux donc te promener d'un à l'autre en les appelant par leurs nouveaux noms
Origine.Activate
Cells.copy
Destination.Activate
Range("A1").Pastespecial
MPi
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
13 févr. 2007 à 00:32
13 févr. 2007 à 00:32
Je craque, ca marche tjs pas, même ta solution MPi. J'arrive a créer mes variables worskbook a faire mes set mais apres quand je les utilise ca plante tjs.
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
13 févr. 2007 à 02:41
13 févr. 2007 à 02:41
Si je me fie à ton premier message qui émane de ton projet de départ mais qui a peut-être changé en cours de route...
Avant ces déclarations, mets un MsgBox pour au moins t'assurer que tu as bien une valeur valable.
Sheets(Destination.txt_old_onglet.Text)
Sheets(Destination.txt_new_onglet.Text).Select
Du genre
MsgBox Destination.txt_old_onglet.Text
Qu'est-ce que tu reçois comme chaîne(s) de message ?
MPi
Avant ces déclarations, mets un MsgBox pour au moins t'assurer que tu as bien une valeur valable.
Sheets(Destination.txt_old_onglet.Text)
Sheets(Destination.txt_new_onglet.Text).Select
Du genre
MsgBox Destination.txt_old_onglet.Text
Qu'est-ce que tu reçois comme chaîne(s) de message ?
MPi
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
13 févr. 2007 à 11:22
13 févr. 2007 à 11:22
Dim fichier As Variant
Dim ligne As String
Dim premier_decoupage() As String
Dim donnees_generales() As String
Dim donnees_libelles() As String
Dim donnees_PR() As String
Dim donnees_LU() As String
Dim detail_donnees_PR()
Dim detail_donnees_LU()
Dim i As Long
Dim depart, count, j, k, l, x As Integer
Dim monTab() As String
Dim new_ch, new_class, old_class, new_ong, old_ong As String
Dim classeur_origine As Workbook
Dim classeur_cible As Workbook
Dim feuille_origine As Worksheet
Dim feuille_cible As Worksheet
'''''Ouverture de l'explorateur pour choisir le fichier à charger'''''''''
fichier= Application.GetOpenFilename("Fichiers texte, *.txt", , "Charger le fichier d'export", , False)
If fichier= "" Or fichier= False Then Exit Sub
'''''Initialisationde de la fenêtre destination''''''''''''''''''''''''''''''''''
Destination.cmd_new.Locked = False
Destination.cmd_old.Locked = True
Destination.Option_new = True
Destination.Option_old = False
Destination.txt_new_ch_classeur.Locked = True
Destination.txt_new_nom_classeur.Locked = False
Destination.txt_new_onglet.Locked = False
Destination.txt_old_classeur.Locked = True
Destination.txt_old_onglet.Locked = True
Destination.txt_new_ch_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_nom_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_onglet.BackStyle = fmBackStyleOpaque
Destination.txt_old_classeur.BackStyle = fmBackStyleTransparent
Destination.txt_old_onglet.BackStyle = fmBackStyleTransparent
Destination.txt_new_ch_classeur.Text = ""
Destination.txt_new_nom_classeur.Text = ""
Destination.txt_new_onglet.Text = ""
Destination.txt_old_classeur.Text = ""
Destination.txt_old_onglet.Text = ""
Destination.txt_type_forfait.Text = ""
quit = False
'''''Affichage de la fenêtre destination'''''''''''''''''''''''''''''''''''''''''
Destination.Show
'''''Test si la fenêtre destination à été quitté proprement''''''''''''''''''''''
If quit = True Then Exit Sub
Set classeur_origine = ActiveWorkbook
Set feuille_origine = ActiveSheet
If old = True Then 'Copie le masque de donnée dans une nouvel feuille d'un classeur existant
old_class = Destination.txt_old_classeur
old_ong = Destination.txt_old_onglet
MsgBox Destination.txt_old_classeur
MsgBox Destination.txt_old_onglet
classeur_origine.Activate
feuille_origine.Cells.Copy
Workbooks.Open old_class
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
Sheets.Add
ActiveSheet.Name = old_ong
Set feuille_cible = ActiveSheet
feuille_cible.Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
ElseIf old = False Then 'Copie le masque de donnée dans une feuille d'un nouveau classeur
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
MsgBox Destination.txt_new_ch_classeur
MsgBox Destination.txt_new_nom_classeur
MsgBox Destination.txt_new_onglet
classeur_origine.Activate
feuille_origine.Cells.Copy
Application.Workbooks.Add
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Worksheets(3).Delete
Worksheets(2).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
feuille_cible.Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
End If
Dans le cas old = True j'ai pas de pb le code fonctionne bien et pour info :
MsgBox Destination.txt_old_classeur -> g:\macro\export\class.xls
MsgBox Destination.txt_old_onglet -> feuille
Dans le cas old = True le code plante :
Ca plante sur : feuille_cible.Paste
MsgBox Destination.txt_new_ch_classeur -> g:\macro\export\
MsgBox Destination.txt_new_nom_classeur -> class
MsgBox Destination.txt_new_onglet -> feuille
Voilà si vous arrivez a voir mon erreur avec çà, ca serait super.
Dim ligne As String
Dim premier_decoupage() As String
Dim donnees_generales() As String
Dim donnees_libelles() As String
Dim donnees_PR() As String
Dim donnees_LU() As String
Dim detail_donnees_PR()
Dim detail_donnees_LU()
Dim i As Long
Dim depart, count, j, k, l, x As Integer
Dim monTab() As String
Dim new_ch, new_class, old_class, new_ong, old_ong As String
Dim classeur_origine As Workbook
Dim classeur_cible As Workbook
Dim feuille_origine As Worksheet
Dim feuille_cible As Worksheet
'''''Ouverture de l'explorateur pour choisir le fichier à charger'''''''''
fichier= Application.GetOpenFilename("Fichiers texte, *.txt", , "Charger le fichier d'export", , False)
If fichier= "" Or fichier= False Then Exit Sub
'''''Initialisationde de la fenêtre destination''''''''''''''''''''''''''''''''''
Destination.cmd_new.Locked = False
Destination.cmd_old.Locked = True
Destination.Option_new = True
Destination.Option_old = False
Destination.txt_new_ch_classeur.Locked = True
Destination.txt_new_nom_classeur.Locked = False
Destination.txt_new_onglet.Locked = False
Destination.txt_old_classeur.Locked = True
Destination.txt_old_onglet.Locked = True
Destination.txt_new_ch_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_nom_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_onglet.BackStyle = fmBackStyleOpaque
Destination.txt_old_classeur.BackStyle = fmBackStyleTransparent
Destination.txt_old_onglet.BackStyle = fmBackStyleTransparent
Destination.txt_new_ch_classeur.Text = ""
Destination.txt_new_nom_classeur.Text = ""
Destination.txt_new_onglet.Text = ""
Destination.txt_old_classeur.Text = ""
Destination.txt_old_onglet.Text = ""
Destination.txt_type_forfait.Text = ""
quit = False
'''''Affichage de la fenêtre destination'''''''''''''''''''''''''''''''''''''''''
Destination.Show
'''''Test si la fenêtre destination à été quitté proprement''''''''''''''''''''''
If quit = True Then Exit Sub
Set classeur_origine = ActiveWorkbook
Set feuille_origine = ActiveSheet
If old = True Then 'Copie le masque de donnée dans une nouvel feuille d'un classeur existant
old_class = Destination.txt_old_classeur
old_ong = Destination.txt_old_onglet
MsgBox Destination.txt_old_classeur
MsgBox Destination.txt_old_onglet
classeur_origine.Activate
feuille_origine.Cells.Copy
Workbooks.Open old_class
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
Sheets.Add
ActiveSheet.Name = old_ong
Set feuille_cible = ActiveSheet
feuille_cible.Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
ElseIf old = False Then 'Copie le masque de donnée dans une feuille d'un nouveau classeur
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
MsgBox Destination.txt_new_ch_classeur
MsgBox Destination.txt_new_nom_classeur
MsgBox Destination.txt_new_onglet
classeur_origine.Activate
feuille_origine.Cells.Copy
Application.Workbooks.Add
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Worksheets(3).Delete
Worksheets(2).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
feuille_cible.Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
End If
Dans le cas old = True j'ai pas de pb le code fonctionne bien et pour info :
MsgBox Destination.txt_old_classeur -> g:\macro\export\class.xls
MsgBox Destination.txt_old_onglet -> feuille
Dans le cas old = True le code plante :
Ca plante sur : feuille_cible.Paste
MsgBox Destination.txt_new_ch_classeur -> g:\macro\export\
MsgBox Destination.txt_new_nom_classeur -> class
MsgBox Destination.txt_new_onglet -> feuille
Voilà si vous arrivez a voir mon erreur avec çà, ca serait super.
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
13 févr. 2007 à 12:23
13 févr. 2007 à 12:23
MsgBox Destination.txt_new_nom_classeur -> class
Est-ce que ça ne devrait pas être "class.xls" ?
MPi
Est-ce que ça ne devrait pas être "class.xls" ?
MPi
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
13 févr. 2007 à 14:23
13 févr. 2007 à 14:23
Alor snon j'y avait pensé j'ai essayé aussi mais ca ne change rien.
De toute façon il passe tres bien les 3 lignes suivantes :
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Il plante uniquement en arrivant sur le :
feuille_cible.Paste
Pour la petite histoire revoilà le code en ajoutant le ".xls":
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
MsgBox Destination.txt_new_ch_classeur
MsgBox Destination.txt_new_nom_classeur
MsgBox Destination.txt_new_onglet
classeur_origine.Activate
feuille_origine.Cells.Copy
Application.Workbooks.Add
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Worksheets(3).Delete
Worksheets(2).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
feuille_cible.Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
De toute façon il passe tres bien les 3 lignes suivantes :
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Il plante uniquement en arrivant sur le :
feuille_cible.Paste
Pour la petite histoire revoilà le code en ajoutant le ".xls":
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
MsgBox Destination.txt_new_ch_classeur
MsgBox Destination.txt_new_nom_classeur
MsgBox Destination.txt_new_onglet
classeur_origine.Activate
feuille_origine.Cells.Copy
Application.Workbooks.Add
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Worksheets(3).Delete
Worksheets(2).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
feuille_cible.Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
sobullshit
Messages postés
178
Date d'inscription
vendredi 9 février 2007
Statut
Membre
Dernière intervention
8 juin 2007
13 févr. 2007 à 15:18
13 févr. 2007 à 15:18
tu doi avoir un pb ds t référence (enfin g pa tro regardé mais c ske mon instinct ki ma tjrs trompé me di)
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
13 févr. 2007 à 23:35
13 févr. 2007 à 23:35
Et si tu inversais un peu ?
Peut-être que le presse-papier est modifié avec la création du classeur, les Delete de feuilles,...
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
' MsgBox Destination.txt_new_ch_classeur
' MsgBox Destination.txt_new_nom_classeur
' MsgBox Destination.txt_new_onglet
Application.Workbooks.Add
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Worksheets(3).Delete
Worksheets(2).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
classeur_origine.Activate
feuille_origine.Cells.Copy
classeur_cible.Activate
feuille_cible.Paste ' ou Range("A1").select avant le Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
MPi
Peut-être que le presse-papier est modifié avec la création du classeur, les Delete de feuilles,...
new_ch = Destination.txt_new_ch_classeur
new_class = Destination.txt_new_nom_classeur
new_ong = Destination.txt_new_onglet
' MsgBox Destination.txt_new_ch_classeur
' MsgBox Destination.txt_new_nom_classeur
' MsgBox Destination.txt_new_onglet
Application.Workbooks.Add
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
classeur_cible.SaveAs new_ch & new_class
Application.DisplayAlerts = False
Worksheets(3).Delete
Worksheets(2).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
classeur_origine.Activate
feuille_origine.Cells.Copy
classeur_cible.Activate
feuille_cible.Paste ' ou Range("A1").select avant le Paste
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
MPi
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
14 févr. 2007 à 02:14
14 févr. 2007 à 02:14
Ou encore
classeur_origine.Activate
feuille_origine.Activate
Cells.Select
Selection.Copy
classeur_cible.Activate
....
MPi
classeur_origine.Activate
feuille_origine.Activate
Cells.Select
Selection.Copy
classeur_cible.Activate
....
MPi
Molenn
Messages postés
797
Date d'inscription
mardi 7 juin 2005
Statut
Membre
Dernière intervention
23 février 2011
7
14 févr. 2007 à 11:00
14 févr. 2007 à 11:00
Ben pour moi, c'est normal que ça plante sur feuille_cible.Paste pour la simple et bonne raison qu'en VBA, la syntaxe ActiveSheet.Paste n'est pas valide.
Cette syntaxe est valide, comme dans les exemples que je t'ai donné, pour le .PasteSpecial
Pour le .Paste, il faut en plus repréciser la destination, mais pas dans le Range avant la méthode Paste, mais comme argument de destination (oui, je ne sais, ce n'est pas du tout logique mais bon).
Alors, je sais bien que l'enregistreur de macro nous remonte ce code, mais quand tu essayes de le faire toi-même, ça plante systématiquement !
La bonne syntaxe est par ex. celle-ci :
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("D1:D5")
Tu ne nous as pas donné ton code d'erreur (ou je l'ai raté), mais je suis prêt à parier que tu as une erreur d'exécution 438 : Propriété ou méthode non géréé par cet objet.
Donc, soit tu modifies ton code pour adapter la destination, soit tu passes comme indiqué précédemment par un .PasteSpecial et si tu as besoin de tout, tu fais plusieurs fois (une fois xlValue, une fois xlFormat, ...)
Molenn
Cette syntaxe est valide, comme dans les exemples que je t'ai donné, pour le .PasteSpecial
Pour le .Paste, il faut en plus repréciser la destination, mais pas dans le Range avant la méthode Paste, mais comme argument de destination (oui, je ne sais, ce n'est pas du tout logique mais bon).
Alors, je sais bien que l'enregistreur de macro nous remonte ce code, mais quand tu essayes de le faire toi-même, ça plante systématiquement !
La bonne syntaxe est par ex. celle-ci :
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("D1:D5")
Tu ne nous as pas donné ton code d'erreur (ou je l'ai raté), mais je suis prêt à parier que tu as une erreur d'exécution 438 : Propriété ou méthode non géréé par cet objet.
Donc, soit tu modifies ton code pour adapter la destination, soit tu passes comme indiqué précédemment par un .PasteSpecial et si tu as besoin de tout, tu fais plusieurs fois (une fois xlValue, une fois xlFormat, ...)
Molenn
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
14 févr. 2007 à 12:30
14 févr. 2007 à 12:30
Ok aloers d'abord j erépond à Mpi :
Effectivement ca marche avec ta modif alors merci beaucoup.
Cependant cette version marche :
classeur_origine.Activate
feuille_origine.Cells.Copy
classeur_cible.Activate
mais pas celle là :
classeur_origine.Activate
feuille_origine.Activate
Cells.Select
Selection.Copy
classeur_cible.Activate
Ensuite pour info je venais de trouver une variante qui marche aussi :
feuille_origine.Select
feuille_origine.Copy
ActiveWorkbook.SaveAs new_ch & new_class
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
Enfin je répond à Molenn :
Pour moi selon ma maigre expérience le ActiveSheet.Paste fonctionne, car je l'ai déjà utilisé dans d'autre cas auparavant.
cependant je te crois et j'ai essayé de passer à la version avec le :
ActiveSheet. Paste Destination: =Worksheets("Sheet1").Range("D1:D5")
mais ca ne change rien ca beugue tjs.
Et pour finir mon erreur et la 1003 et non la 438.
Effectivement ca marche avec ta modif alors merci beaucoup.
Cependant cette version marche :
classeur_origine.Activate
feuille_origine.Cells.Copy
classeur_cible.Activate
mais pas celle là :
classeur_origine.Activate
feuille_origine.Activate
Cells.Select
Selection.Copy
classeur_cible.Activate
Ensuite pour info je venais de trouver une variante qui marche aussi :
feuille_origine.Select
feuille_origine.Copy
ActiveWorkbook.SaveAs new_ch & new_class
Set classeur_cible = ActiveWorkbook
classeur_cible.Activate
ActiveSheet.Name = new_ong
Set feuille_cible = ActiveSheet
feuille_cible.Range("C1") = Destination.txt_type_forfait.Text
feuille_cible.Range("C2") = Destination.txt_date_camp.Text
feuille_cible.Range("C3") = Destination.txt_cdp.Text
Enfin je répond à Molenn :
Pour moi selon ma maigre expérience le ActiveSheet.Paste fonctionne, car je l'ai déjà utilisé dans d'autre cas auparavant.
cependant je te crois et j'ai essayé de passer à la version avec le :
ActiveSheet. Paste Destination: =Worksheets("Sheet1").Range("D1:D5")
mais ca ne change rien ca beugue tjs.
Et pour finir mon erreur et la 1003 et non la 438.
Molenn
Messages postés
797
Date d'inscription
mardi 7 juin 2005
Statut
Membre
Dernière intervention
23 février 2011
7
14 févr. 2007 à 14:10
14 févr. 2007 à 14:10
Alors, je vais reprendre ton code, et je l'ai adapté à ma façon de faire qui est celle que je te présentais quelques posts plus tôt.
J'ai supprimé les parties sur l'initialisation du Userform et la récupération du chemin avec la boite de dialogue, ça n'a pas d'impact sur la suite.
J'ai commenté le code, normalement, ça devrait être assez clair :
J'ai modifié les déclarations de variable, je ne travaille qu'avec des String personnellement (au passage, dans ton code, les variables
Dim depart, count, j, k, l, x As Integer
Dim new_ch, new_class, old_class, new_ong, old_ong As String
sont mal déclarées, elles sont toutes de type variant, seules x est de type Integer et oldçong de type String).
L'autre différence, c'est que je n'ai pas recrée ton UserForm, donc, j'ai mis les infos en dur. J'ai laissé au bout des lignes le code du UserForm, tu pourras recréer simplement chez toi la bonne syntaxe.
'Je ne trouve pas trace de ta variable old, un oubli sans doute, donc je la déclare comme suit
Dim old As Boolean
'Variables du classeur d'origine
Dim classeur_origine As String
Dim feuille_origine As String
'variable du classeur cible
Dim classeur_cible As String
'Variables du classeur déjà existant
Dim old_class As String
Dim old_ong As String
'Variable du classeur crée
Dim new_ch As String
Dim new_class As String
Dim new_ong As String
'Récupération des infos sur le classeur d'origine
classeur_origine = ActiveWorkbook.Name
feuille_origine = ActiveSheet.Name
'Par rapport à ton userform, une différence, je sépare le chemin du nom du fichier (sinon, on peut le retrouver, mais c'est se compliquer pour rien je trouve)
'Plus simple pour moi
old = MsgBox("Old?", vbYesNo)
'Je ne sais pas à quoi correspond ta variable old, je l'alimente donc avec une msgbox pour tester les 2 cas
If old = vbYes Then 'Copie le masque de donnée dans une nouvelle feuille d'un classeur existant
'Chemin du classeur déjà existant
old_class = "C:\TEMP" 'Destination.txt_old_classeur
'Nom du classeur déjà existant avec l'extension .xls
classeur_cible = "class.xls"
'Nom de l'onglet de destination
old_ong = "feuille" 'Destination.txt_old_onglet
'Ouverture du classeur de destination
Workbooks.Open (old_class & classeur_cible)
'Ajout d'un onglet dans le classeur déjà existant
Workbooks(classeur_cible).Sheets.Add
Workbooks(classeur_cible).ActiveSheet.Name = old_ong
'Copie des données d'origine
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
'Collage dans le classeur déjà existant
Workbooks(classeur_cible).Worksheets(old_ong).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(classeur_cible).Worksheets(old_ong).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Mise à jour des infos
Workbooks(classeur_cible).Worksheets(old_ong).Range("C1") = "Forfait" 'Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(old_ong).Range("C2") = "Date" 'Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(old_ong).Range("C3") = "CDP" 'Destination.txt_cdp.Text
Else
'Copie le masque de donnée dans une feuille d'un nouveau classeur
new_ch = "C:\TEMP" 'Destination.txt_new_ch_classeur
new_class = "toto.xls" 'Destination.txt_new_nom_classeur
new_ong = "Test" 'Destination.txt_new_onglet
'Création et enregistrement du nouveau classeur
Application.Workbooks.Add (xlWBATWorksheet) 'En mettant cette constante, plus besoin de supprimer les feuilles en trop
classeur_cible = ActiveWorkbook.Name
Workbooks(classeur_cible).ActiveSheet.Name = new_ong
Workbooks(classeur_cible).SaveAs new_ch & new_class
classeur_cible = ActiveWorkbook.Name
'Copie des données d'origine
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
'Collage dans le classeur crée
Workbooks(classeur_cible).Worksheets(new_ong).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(classeur_cible).Worksheets(new_ong).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Mise à jour des infos
Workbooks(classeur_cible).Worksheets(new_ong).Range("C1") = "Forfait" 'Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(new_ong).Range("C2") = "Date" 'Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(new_ong).Range("C3") = "CDP" 'Destination.txt_cdp.Text
End If
Chez moi, aucun souci quelque soit le mode de copie.
Molenn
J'ai supprimé les parties sur l'initialisation du Userform et la récupération du chemin avec la boite de dialogue, ça n'a pas d'impact sur la suite.
J'ai commenté le code, normalement, ça devrait être assez clair :
J'ai modifié les déclarations de variable, je ne travaille qu'avec des String personnellement (au passage, dans ton code, les variables
Dim depart, count, j, k, l, x As Integer
Dim new_ch, new_class, old_class, new_ong, old_ong As String
sont mal déclarées, elles sont toutes de type variant, seules x est de type Integer et oldçong de type String).
L'autre différence, c'est que je n'ai pas recrée ton UserForm, donc, j'ai mis les infos en dur. J'ai laissé au bout des lignes le code du UserForm, tu pourras recréer simplement chez toi la bonne syntaxe.
'Je ne trouve pas trace de ta variable old, un oubli sans doute, donc je la déclare comme suit
Dim old As Boolean
'Variables du classeur d'origine
Dim classeur_origine As String
Dim feuille_origine As String
'variable du classeur cible
Dim classeur_cible As String
'Variables du classeur déjà existant
Dim old_class As String
Dim old_ong As String
'Variable du classeur crée
Dim new_ch As String
Dim new_class As String
Dim new_ong As String
'Récupération des infos sur le classeur d'origine
classeur_origine = ActiveWorkbook.Name
feuille_origine = ActiveSheet.Name
'Par rapport à ton userform, une différence, je sépare le chemin du nom du fichier (sinon, on peut le retrouver, mais c'est se compliquer pour rien je trouve)
'Plus simple pour moi
old = MsgBox("Old?", vbYesNo)
'Je ne sais pas à quoi correspond ta variable old, je l'alimente donc avec une msgbox pour tester les 2 cas
If old = vbYes Then 'Copie le masque de donnée dans une nouvelle feuille d'un classeur existant
'Chemin du classeur déjà existant
old_class = "C:\TEMP" 'Destination.txt_old_classeur
'Nom du classeur déjà existant avec l'extension .xls
classeur_cible = "class.xls"
'Nom de l'onglet de destination
old_ong = "feuille" 'Destination.txt_old_onglet
'Ouverture du classeur de destination
Workbooks.Open (old_class & classeur_cible)
'Ajout d'un onglet dans le classeur déjà existant
Workbooks(classeur_cible).Sheets.Add
Workbooks(classeur_cible).ActiveSheet.Name = old_ong
'Copie des données d'origine
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
'Collage dans le classeur déjà existant
Workbooks(classeur_cible).Worksheets(old_ong).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(classeur_cible).Worksheets(old_ong).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Mise à jour des infos
Workbooks(classeur_cible).Worksheets(old_ong).Range("C1") = "Forfait" 'Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(old_ong).Range("C2") = "Date" 'Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(old_ong).Range("C3") = "CDP" 'Destination.txt_cdp.Text
Else
'Copie le masque de donnée dans une feuille d'un nouveau classeur
new_ch = "C:\TEMP" 'Destination.txt_new_ch_classeur
new_class = "toto.xls" 'Destination.txt_new_nom_classeur
new_ong = "Test" 'Destination.txt_new_onglet
'Création et enregistrement du nouveau classeur
Application.Workbooks.Add (xlWBATWorksheet) 'En mettant cette constante, plus besoin de supprimer les feuilles en trop
classeur_cible = ActiveWorkbook.Name
Workbooks(classeur_cible).ActiveSheet.Name = new_ong
Workbooks(classeur_cible).SaveAs new_ch & new_class
classeur_cible = ActiveWorkbook.Name
'Copie des données d'origine
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
'Collage dans le classeur crée
Workbooks(classeur_cible).Worksheets(new_ong).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(classeur_cible).Worksheets(new_ong).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Mise à jour des infos
Workbooks(classeur_cible).Worksheets(new_ong).Range("C1") = "Forfait" 'Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(new_ong).Range("C2") = "Date" 'Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(new_ong).Range("C3") = "CDP" 'Destination.txt_cdp.Text
End If
Chez moi, aucun souci quelque soit le mode de copie.
Molenn
Molenn
Messages postés
797
Date d'inscription
mardi 7 juin 2005
Statut
Membre
Dernière intervention
23 février 2011
7
14 févr. 2007 à 14:34
14 févr. 2007 à 14:34
Oups, j'ai fait une petite erreur :
La première : la variable old
Dim old As Integer au lieu de Dim old As Boolean
et
If old = 6 au lieu de If old = vbYes
Tant que j'y étais, j'ai simplifié le code puisqu'entre les deux parties de ta condition, tu as du code en doublon.
Ce qui donne :
Private Sub CommandButton1_Click()
'Je ne trouve pas trace de ta variable old, un oubli sans doute, donc je la déclare comme suit
Dim old As Integer
'Variables du classeur d'origine
Dim classeur_origine As String
Dim feuille_origine As String
'Variable du classeur cible
Dim classeur_cible As String
Dim classeur_temporaire As String 'Obligatoire, juste pour l'enregistrement du fichier avec le nouveau nom quand on crée un classeur
Dim feuille_cible As String
Dim chemin_cible As String
'Récupération des infos sur le classeur d'origine
classeur_origine = ActiveWorkbook.Name
feuille_origine = ActiveSheet.Name
'Par rapport à ton userform, une différence, je sépare le chemin du nom du fichier (sinon, on peut le retrouver, mais c'est se compliquer pour rien je trouve)
'Plus simple pour moi
old = MsgBox("Old?", vbYesNo)
'Je ne sais pas à quoi correspond ta variable old, je l'alimente donc avec une msgbox pour tester les 2 cas
If old = 6 Then 'Copie le masque de donnée dans une nouvelle feuille d'un classeur existant
'Chemin du classeur cible
chemin_cible = "C:\TEMP" 'Destination.txt_old_classeur
classeur_cible = "class.xls" 'Nom du classeur déjà existant avec l'extension .xls
feuille_cible = "feuille" 'Destination.txt_old_onglet
'Ouverture du classeur de destination
Workbooks.Open (chemin_cible & classeur_cible)
'Ajout d'un onglet dans le classeur déjà existant
Workbooks(classeur_cible).Sheets.Add
Workbooks(classeur_cible).ActiveSheet.Name = feuille_cible
Else 'Copie le masque de donnée dans une feuille d'un nouveau classeur
chemin_cible = "C:\TEMP" 'Destination.txt_new_ch_classeur
classeur_cible = "toto.xls" 'Destination.txt_new_nom_classeur
feuille_cible = "Test" 'Destination.txt_new_onglet
'Création et enregistrement du nouveau classeur
Application.Workbooks.Add (xlWBATWorksheet) 'En mettant cette constante, plus besoin de supprimer les feuilles en trop
classeur_temporaire = ActiveWorkbook.Name
Workbooks(classeur_temporaire).ActiveSheet.Name = feuille_cible
Workbooks(classeur_temporaire).SaveAs chemin_cible & classeur_cible
classeur_cible = ActiveWorkbook.Name
End If
'Copie des données d'origine
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
'Collage dans le classeur déjà existant
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Mise à jour des infos
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C1") = "Forfait" 'Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C2") = "Date" 'Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C3") = "CDP" 'Destination.txt_cdp.Text
End Sub
La première : la variable old
Dim old As Integer au lieu de Dim old As Boolean
et
If old = 6 au lieu de If old = vbYes
Tant que j'y étais, j'ai simplifié le code puisqu'entre les deux parties de ta condition, tu as du code en doublon.
Ce qui donne :
Private Sub CommandButton1_Click()
'Je ne trouve pas trace de ta variable old, un oubli sans doute, donc je la déclare comme suit
Dim old As Integer
'Variables du classeur d'origine
Dim classeur_origine As String
Dim feuille_origine As String
'Variable du classeur cible
Dim classeur_cible As String
Dim classeur_temporaire As String 'Obligatoire, juste pour l'enregistrement du fichier avec le nouveau nom quand on crée un classeur
Dim feuille_cible As String
Dim chemin_cible As String
'Récupération des infos sur le classeur d'origine
classeur_origine = ActiveWorkbook.Name
feuille_origine = ActiveSheet.Name
'Par rapport à ton userform, une différence, je sépare le chemin du nom du fichier (sinon, on peut le retrouver, mais c'est se compliquer pour rien je trouve)
'Plus simple pour moi
old = MsgBox("Old?", vbYesNo)
'Je ne sais pas à quoi correspond ta variable old, je l'alimente donc avec une msgbox pour tester les 2 cas
If old = 6 Then 'Copie le masque de donnée dans une nouvelle feuille d'un classeur existant
'Chemin du classeur cible
chemin_cible = "C:\TEMP" 'Destination.txt_old_classeur
classeur_cible = "class.xls" 'Nom du classeur déjà existant avec l'extension .xls
feuille_cible = "feuille" 'Destination.txt_old_onglet
'Ouverture du classeur de destination
Workbooks.Open (chemin_cible & classeur_cible)
'Ajout d'un onglet dans le classeur déjà existant
Workbooks(classeur_cible).Sheets.Add
Workbooks(classeur_cible).ActiveSheet.Name = feuille_cible
Else 'Copie le masque de donnée dans une feuille d'un nouveau classeur
chemin_cible = "C:\TEMP" 'Destination.txt_new_ch_classeur
classeur_cible = "toto.xls" 'Destination.txt_new_nom_classeur
feuille_cible = "Test" 'Destination.txt_new_onglet
'Création et enregistrement du nouveau classeur
Application.Workbooks.Add (xlWBATWorksheet) 'En mettant cette constante, plus besoin de supprimer les feuilles en trop
classeur_temporaire = ActiveWorkbook.Name
Workbooks(classeur_temporaire).ActiveSheet.Name = feuille_cible
Workbooks(classeur_temporaire).SaveAs chemin_cible & classeur_cible
classeur_cible = ActiveWorkbook.Name
End If
'Copie des données d'origine
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
'Collage dans le classeur déjà existant
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Mise à jour des infos
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C1") = "Forfait" 'Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C2") = "Date" 'Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C3") = "CDP" 'Destination.txt_cdp.Text
End Sub
olivier857
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
14 févr. 2007 à 23:44
14 févr. 2007 à 23:44
Ok Molenn interessant tout çà.
J'ai donc essayer de travailler comme toi et j'ai adapter ton code au reste de mon projet, a savoir par exemple avec les données provenant de mon userform. Pour info la variable old est déclaré en global.
Et voilà le résultat :
Private Sub cmd_import_Click()
Dim fichier As Variant
Dim ch_class() As String
Dim chemin_cible As String
Dim classeur_origine As String
Dim classeur_cible As String
Dim classeur_temporaire As String
Dim feuille_macro As String
Dim feuille_origine As String
Dim feuille_cible As String
Dim ligne As String
Dim premier_decoupage() As String
Dim donnees_generales() As String
Dim donnees_libelles() As String
Dim donnees_PR() As String
Dim donnees_LU() As String
Dim detail_donnees_PR()
Dim detail_donnees_LU()
Dim depart As Integer
Dim count As Integer
Dim i As Long
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim x As Integer
'''''Ouverture de l'explorateur pour choisir le fichier texte à charger'''''''''
fichier = Application.GetOpenFilename("Fichiers texte, *.txt", , "Charger le fichier d'export", , False) If fichier "" Or fichier False Then Exit Sub
'''''Initialisationde de la fenêtre destination''''''''''''''''''''''''''''''''''
Destination.cmd_new.Locked = False
Destination.cmd_old.Locked = True
Destination.Option_new = True
Destination.Option_old = False
Destination.txt_new_ch_classeur.Locked = True
Destination.txt_new_nom_classeur.Locked = False
Destination.txt_new_onglet.Locked = False
Destination.txt_old_classeur.Locked = True
Destination.txt_old_onglet.Locked = True
Destination.txt_new_ch_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_nom_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_onglet.BackStyle = fmBackStyleOpaque
Destination.txt_old_classeur.BackStyle = fmBackStyleTransparent
Destination.txt_old_onglet.BackStyle = fmBackStyleTransparent
Destination.txt_new_ch_classeur.Text = ""
Destination.txt_new_nom_classeur.Text = ""
Destination.txt_new_onglet.Text = ""
Destination.txt_old_classeur.Text = ""
Destination.txt_old_onglet.Text = ""
Destination.txt_type_forfait.Text = ""
quit = False
'''''Affichage de la fenêtre destination'''''''''''''''''''''''''''''''''''''''''
Destination.Show
'''''Test si la fenêtre destination à été quitté proprement''''''''''''''''''''''
If quit = True Then Exit Sub
'''''Récupération des infos sur le classeur d'origine''''''''''''''''''''''''''''
classeur_origine = ActiveWorkbook.Name
feuille_origine = "Masque Macro"
feuille_macro = ActiveSheet.Name
If old = True Then 'Copie dans une nouvel feuille d'un classeur existant
ch_class() = Split(Destination.txt_old_classeur.Text, "")
x = UBound(ch_class)
classeur_cible = ch_class(x)
feuille_cible = Destination.txt_old_onglet.Text
Workbooks.Open classeur_cible
x = Sheets.count
Workbooks(classeur_cible).Sheets.Add after:=Sheets(x)
Workbooks(classeur_cible).ActiveSheet.Name = feuille_cible
ElseIf old = False Then 'Copie dans une feuille d'un nouveau classeur
chemin_cible = Destination.txt_new_ch_classeur.Text
classeur_cible = Destination.txt_new_nom_classeur.Text & ".xls"
feuille_cible = Destination.txt_new_onglet.Text
Application.Workbooks.Add (xlWBATWorksheet)
classeur_temporaire = ActiveWorkbook.Name
Workbooks(classeur_temporaire).ActiveSheet.Name = feuille_cible
Workbooks(classeur_temporaire).SaveAs chemin_cible & classeur_cible
End If
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
Workbooks(classeur_cible).Worksheets(feuille_cible).Paste
'Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.DisplayGridlines = False
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C1") = Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C2") = Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C3") = Destination.txt_cdp.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("G1").Select
'''''Ouverture du fichier texte'''''''''''''''''''''''''''''''''''''''
Open fichier For Input As #1
'''''Initialisation du compteur de ligne Excel''''''''''''''''''''''''''''''''
depart = 7
i = depart
Do While Not EOF(1)
'Lecture des lignes du fichier texte
Line Input #1, ligne
''''''''Récupération des données de chaque ligne''''''''''''''''''''''''''''''
premier_decoupage = Split(ligne, "///1///")
donnees_generales = Split(premier_decoupage(0), vbTab)
donnees_libelles = Split(premier_decoupage(1), vbTab)
donnees_PR = Split(premier_decoupage(2), vbTab)
donnees_LU = Split(premier_decoupage(3), vbTab)
If UBound(donnees_PR) >= 0 Then
ReDim detail_donnees_PR(0 To UBound(donnees_PR))
For j = 0 To UBound(donnees_PR)
detail_donnees_PR(j) = Split(donnees_PR(j), " - ")
Next j
End If
If UBound(donnees_LU) >= 0 Then
ReDim detail_donnees_LU(0 To UBound(donnees_LU))
For j = 0 To UBound(donnees_LU)
detail_donnees_LU(j) = Split(donnees_LU(j), " - ")
Next j
End If
''''''''Copie des données dans excel''''''''''''''''''''''''''''''''''''''''''
count = 1
For j = 0 To UBound(donnees_generales)
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + j) = donnees_generales(j)
Next j
count = count + j
For j = 0 To UBound(donnees_libelles)
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + j) = donnees_libelles(j)
l = l + 1
Next j
count = count + j
l = 0
If UBound(donnees_PR) >= 0 Then
For j = 0 To UBound(detail_donnees_PR)
For k = 0 To UBound(detail_donnees_PR(j))
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + l) = detail_donnees_PR(j)(k)
l = l + 1
Next k
Next j
End If
count = count + l
l = 0
If UBound(donnees_LU) >= 0 Then
For j = 0 To UBound(detail_donnees_LU)
For k = 0 To UBound(detail_donnees_LU(j))
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + l) = detail_donnees_LU(j)(k)
l = l + 1
Next k
Next j
End If
''''''''Incrémentation du compteur de ligne'''''''''''''''''''''''''''''''''''
i = i + 1
Loop
''''Sauvegarde du classeur d'importation'''''''''''''''''''''''''''''''''''''''''
Workbooks(classeur_cible).Save
''''Fermeture du fichier texte valfor'''''''''''''''''''''''''''''''''''''''''
Close #1
Application.ScreenUpdating = True
End Sub
Merci bcp de ton aide, même si j'ai réussi a débeugué mon code précédant grace notament à l'aide de Mpi (que je remercie aussi) je crois que je vais garder ta version car effectivement elle me parait plus simple.
J'ai donc essayer de travailler comme toi et j'ai adapter ton code au reste de mon projet, a savoir par exemple avec les données provenant de mon userform. Pour info la variable old est déclaré en global.
Et voilà le résultat :
Private Sub cmd_import_Click()
Dim fichier As Variant
Dim ch_class() As String
Dim chemin_cible As String
Dim classeur_origine As String
Dim classeur_cible As String
Dim classeur_temporaire As String
Dim feuille_macro As String
Dim feuille_origine As String
Dim feuille_cible As String
Dim ligne As String
Dim premier_decoupage() As String
Dim donnees_generales() As String
Dim donnees_libelles() As String
Dim donnees_PR() As String
Dim donnees_LU() As String
Dim detail_donnees_PR()
Dim detail_donnees_LU()
Dim depart As Integer
Dim count As Integer
Dim i As Long
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim x As Integer
'''''Ouverture de l'explorateur pour choisir le fichier texte à charger'''''''''
fichier = Application.GetOpenFilename("Fichiers texte, *.txt", , "Charger le fichier d'export", , False) If fichier "" Or fichier False Then Exit Sub
'''''Initialisationde de la fenêtre destination''''''''''''''''''''''''''''''''''
Destination.cmd_new.Locked = False
Destination.cmd_old.Locked = True
Destination.Option_new = True
Destination.Option_old = False
Destination.txt_new_ch_classeur.Locked = True
Destination.txt_new_nom_classeur.Locked = False
Destination.txt_new_onglet.Locked = False
Destination.txt_old_classeur.Locked = True
Destination.txt_old_onglet.Locked = True
Destination.txt_new_ch_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_nom_classeur.BackStyle = fmBackStyleOpaque
Destination.txt_new_onglet.BackStyle = fmBackStyleOpaque
Destination.txt_old_classeur.BackStyle = fmBackStyleTransparent
Destination.txt_old_onglet.BackStyle = fmBackStyleTransparent
Destination.txt_new_ch_classeur.Text = ""
Destination.txt_new_nom_classeur.Text = ""
Destination.txt_new_onglet.Text = ""
Destination.txt_old_classeur.Text = ""
Destination.txt_old_onglet.Text = ""
Destination.txt_type_forfait.Text = ""
quit = False
'''''Affichage de la fenêtre destination'''''''''''''''''''''''''''''''''''''''''
Destination.Show
'''''Test si la fenêtre destination à été quitté proprement''''''''''''''''''''''
If quit = True Then Exit Sub
'''''Récupération des infos sur le classeur d'origine''''''''''''''''''''''''''''
classeur_origine = ActiveWorkbook.Name
feuille_origine = "Masque Macro"
feuille_macro = ActiveSheet.Name
If old = True Then 'Copie dans une nouvel feuille d'un classeur existant
ch_class() = Split(Destination.txt_old_classeur.Text, "")
x = UBound(ch_class)
classeur_cible = ch_class(x)
feuille_cible = Destination.txt_old_onglet.Text
Workbooks.Open classeur_cible
x = Sheets.count
Workbooks(classeur_cible).Sheets.Add after:=Sheets(x)
Workbooks(classeur_cible).ActiveSheet.Name = feuille_cible
ElseIf old = False Then 'Copie dans une feuille d'un nouveau classeur
chemin_cible = Destination.txt_new_ch_classeur.Text
classeur_cible = Destination.txt_new_nom_classeur.Text & ".xls"
feuille_cible = Destination.txt_new_onglet.Text
Application.Workbooks.Add (xlWBATWorksheet)
classeur_temporaire = ActiveWorkbook.Name
Workbooks(classeur_temporaire).ActiveSheet.Name = feuille_cible
Workbooks(classeur_temporaire).SaveAs chemin_cible & classeur_cible
End If
Workbooks(classeur_origine).Worksheets(feuille_origine).Cells.Copy
Workbooks(classeur_cible).Worksheets(feuille_cible).Paste
'Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.DisplayGridlines = False
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C1") = Destination.txt_type_forfait.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C2") = Destination.txt_date_camp.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("C3") = Destination.txt_cdp.Text
Workbooks(classeur_cible).Worksheets(feuille_cible).Range("G1").Select
'''''Ouverture du fichier texte'''''''''''''''''''''''''''''''''''''''
Open fichier For Input As #1
'''''Initialisation du compteur de ligne Excel''''''''''''''''''''''''''''''''
depart = 7
i = depart
Do While Not EOF(1)
'Lecture des lignes du fichier texte
Line Input #1, ligne
''''''''Récupération des données de chaque ligne''''''''''''''''''''''''''''''
premier_decoupage = Split(ligne, "///1///")
donnees_generales = Split(premier_decoupage(0), vbTab)
donnees_libelles = Split(premier_decoupage(1), vbTab)
donnees_PR = Split(premier_decoupage(2), vbTab)
donnees_LU = Split(premier_decoupage(3), vbTab)
If UBound(donnees_PR) >= 0 Then
ReDim detail_donnees_PR(0 To UBound(donnees_PR))
For j = 0 To UBound(donnees_PR)
detail_donnees_PR(j) = Split(donnees_PR(j), " - ")
Next j
End If
If UBound(donnees_LU) >= 0 Then
ReDim detail_donnees_LU(0 To UBound(donnees_LU))
For j = 0 To UBound(donnees_LU)
detail_donnees_LU(j) = Split(donnees_LU(j), " - ")
Next j
End If
''''''''Copie des données dans excel''''''''''''''''''''''''''''''''''''''''''
count = 1
For j = 0 To UBound(donnees_generales)
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + j) = donnees_generales(j)
Next j
count = count + j
For j = 0 To UBound(donnees_libelles)
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + j) = donnees_libelles(j)
l = l + 1
Next j
count = count + j
l = 0
If UBound(donnees_PR) >= 0 Then
For j = 0 To UBound(detail_donnees_PR)
For k = 0 To UBound(detail_donnees_PR(j))
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + l) = detail_donnees_PR(j)(k)
l = l + 1
Next k
Next j
End If
count = count + l
l = 0
If UBound(donnees_LU) >= 0 Then
For j = 0 To UBound(detail_donnees_LU)
For k = 0 To UBound(detail_donnees_LU(j))
Workbooks(classeur_cible).Worksheets(feuille_cible).Cells(i, count + l) = detail_donnees_LU(j)(k)
l = l + 1
Next k
Next j
End If
''''''''Incrémentation du compteur de ligne'''''''''''''''''''''''''''''''''''
i = i + 1
Loop
''''Sauvegarde du classeur d'importation'''''''''''''''''''''''''''''''''''''''''
Workbooks(classeur_cible).Save
''''Fermeture du fichier texte valfor'''''''''''''''''''''''''''''''''''''''''
Close #1
Application.ScreenUpdating = True
End Sub
Merci bcp de ton aide, même si j'ai réussi a débeugué mon code précédant grace notament à l'aide de Mpi (que je remercie aussi) je crois que je vais garder ta version car effectivement elle me parait plus simple.