Copie de données d'un classeur à l'autre

Question

Bonjour à tous,

J'ai un problème de copie de donées d'un classeur à l'autre et ne trouve pas de solution. Apparement le problème provient de ma demarche de selection des cellules avant collage des données, celles-ci ne noit pas correspondre à ma cellule copier, ou bien alors je ne suis peut être pas le bonne ordre pour activer le classeur, la feuille et les cellules,...

Voici mon code, on y retrouve en rouge la partie problématique :

Private Sub cmd_import_Click()


    Dim fichier_valfor As Variant
    Dim classeur_cible As Workbook
    Dim feuille_cible As Worksheet
    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


'''''Initialisationde de la fenêtre destination''''''''''''''''''''''''''''''''''
    Destination.cmd_old.Locked = True
    Destination.Option_new = True
    Destination.Option_old = False
    Destination.txt_new_ch_classeur.Locked = False
    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 = "G:\Outil Valfor\Valfor excel"
    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

''''''Copie du masque de donnée'''''''''''''''''''''''''''''''''''''''''''''''
    If old = True Then  'Copie dans un nouvel onglet d'un classeur existant
        Worksheets("macro").Select
        Cells.Select
        Selection.Copy
        Workbooks.Open Destination.txt_old_classeur.Text
        Sheets.Add
        ActiveSheet.Name = Destination.txt_old_onglet.Text
        Sheets(Destination.txt_old_onglet.Text).Select
        Cells.Select
        ActiveSheet.Paste
        Range("C1") = Destination.txt_type_forfait.Text
        Range("C2") = Destination.txt_date_camp.Text
        Range("C3") = Destination.txt_cdp.Text
        Set classeur_cible = ActiveWorkbook
        Set feuille_cible = ActiveSheet
    ElseIf old = False Then 'Copie dans un nouveau classeur
        Worksheets("macro").Select
        Cells.Select
        Selection.Copy
        Application.Workbooks.Add
        Application.DisplayAlerts = False
        ActiveWorkbook.Worksheets(3).Delete
        ActiveWorkbook.Worksheets(2).Delete
        ActiveWorkbook.Worksheets(1).Name = Destination.txt_new_onglet.Text
        Application.DisplayAlerts = True
        ActiveWorkbook.Activate
        Sheets(Destination.txt_new_onglet.Text).Select
        Cells.Select
        ActiveSheet.Paste
        Range("C1") = Destination.txt_type_forfait.Text
        Range("C2") = Destination.txt_date_camp.Text
        Range("C3") = Destination.txt_cdp.Text
        Set classeur_cible = ActiveWorkbook
        Set feuille_cible = ActiveSheet
    End If

Voilà si quelqu'un peut m'espliquer mon erreur ca serait génial.

Merci d'avance

Olivier

cs_MPi · Answer

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

drouault · Answer

Et comme ça ????

Compte.Worksheets(Destination.txt_old_onglet.Text).Cells(1, 1).Select

Pierre

Molenn · Answer

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

olivier857 · Answer

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

Molenn · Answer

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

olivier857 · Answer

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.

cs_MPi · Answer

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

olivier857 · Answer

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 · Answer

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

olivier857 · Answer

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.

cs_MPi · Answer

MsgBox Destination.txt_new_nom_classeur -> class
Est-ce que ça ne devrait pas être "class.xls" ?

MPi

olivier857 · Answer

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

sobullshit · Answer

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 · Answer

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

cs_MPi · Answer

Ou encore
        classeur_origine.Activate
         feuille_origine.Activate
        Cells.Select
        Selection.Copy
        classeur_cible.Activate
        ....

MPi

Molenn · Answer

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

olivier857 · Answer

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.

Molenn · Answer

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

Molenn · Answer

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

olivier857 · Answer

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.

olivier857 · Answer

J'ao oublé de présisé que pour le collage des données, il y a 2 version qui marche.

La tienne : 

   '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

Et celle-ci :

Workbooks(classeur_cible).Worksheets(feuille_cible).Paste

Mais par contre ca non : 

Workbooks(classeur_cible).Worksheets(feuille_cible).Cells.Paste

Alors voilà, quel version utiliser, la seconde est plus courte et simple mais est t'elle réellement bien conseillée ?

Copie de données d'un classeur à l'autre

21 réponses

Votre réponse

Discussions similaires