Copie spécifique d'un classeur A vers un classeur B sur une autre feuille

[Mikayel]

Bonsoir à tous,

Je viens vers vous car mes recherches sur internet ne m'ont pas conduit à la résolution de mon problème et mes formules ne fonctionnent pas.

Je suis sur un problème un peu compliqué (à mes yeux). J'ai un fichier nommé "Transposition.xlsm" où dans la feuille "Journal titan" je cherche à récupérer les valeurs contenues dans un fichier nommé "Journal.xls" (les données se trouvent sur la feuille nommée "A"). La sélection doit se faire de B4 à Gx sur "Journal.xls", "A". X est la longueur variable des données que ces datas peuvent contenir. Le collage doit se faire en valeurs.

    ' AJOUT DES DONNEES

    Workbooks.Open "Journal.xls"
    Windows("Journal.xls").Activate
    ActiveWorkbook.Worksheets("A").Select
    Nb_Lignes = Range("B4").End(xlDown).Row
    Range("B4:G" & Nb_lignes).Select
    Selection.Copy
    Windows("Transposition.xlsm").Activate
    ActiveWorkbook.Worksheets("Journal titan").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Workbooks("Journal.xls").Close savechanges:=False

Autant vous dire que ce code fait planter mon ordinateur .

Peut-être suis-je sur une piste complètement fausse? Un must serait de pouvoir à la base pouvoir sélectionner le fichier via une fenêtre (mais de tout le temps récupérer dans le fichier sélectionné B4:Gx).

Je vous remercie d'avance pour votre aide et vous souhaite à tous une bonne soirée,

Michaël

 

[Fred0o]

Re : Copie spécifique d'un classeur A vers un classeur B sur une autre feuille

Bonsoir Mikayel,

Voici le code que tu peux mettre en remplacement du tien. Ceci corrige tes erreurs et permet de choisir le fichier à ouvrir.

Dim NomFichier, Nb_Lignes
NomFichier = Application.GetOpenFilename("xls Files (*.xls), *.xls")
If NomFichier = "Faux" Then Exit Sub
Application.DisplayAlerts = False
Workbooks.Open NomFichier
ActiveWorkbook.Worksheets("A").Select
Nb_Lignes = Range("B4").End(xlDown).Row
Range("B4:G" & Nb_Lignes).Select
Selection.Copy
Windows("Transposition.xlsm").Activate
ActiveWorkbook.Worksheets("Journal titan").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("Journal.xls").Close savechanges:=False
Application.DisplayAlerts = True

A+

 

[Mikayel]

Re : Copie spécifique d'un classeur A vers un classeur B sur une autre feuille

Bonjour,

Merci pour votre réponse! Ça marche déjà mieux que mon code.

Cependant il ne copie de la feuille A (du fichier Journal.xls) seulement la cellule A1...

De plus, le fichier fermé à la fin du code est Journal.xls mais la source ne portera peut être pas toujours ce nom et en remplaçant

Workbooks("Journal.xls").Close savechanges:=False
Workbooks(NomFichier).Close savechanges:=False

Ca ne marche pas non plus...

Auriez-vous une idée pour résoudre ces problèmes?

Merci d'avance,

Michaël

 

[Fred0o]

Re : Copie spécifique d'un classeur A vers un classeur B sur une autre feuille

Bonjour Mikayel,

J'ai modifié le code pour qu'il puisse fermer le fichier ouvert par sélection. Fais attention, ce fichier doit obligatoirement contenir les données dans une Feuille nommée "A" (c'est ce qui était défini à la base dans ton code).

Pour ce qui est de la seule cellule A1 copiée, c'est impossible car le code copie la plage "B4:G...". Il est possible que seules les cellules "B4:G4" soient copiées si tu as des lignes vides sous la ligne 4 et que tu veuilles copier d'autres ligne situées plus bas.

Je me suis cantonné au débuggage de ton code initial, si tes besoins sont différents, il faut que tu me les précises clairement.

Je te mets un classeur avec le code qui fonctionne chez moi et copie bien toute la plage spécifiée.

A+

 

[Mikayel]

Re : Copie spécifique d'un classeur A vers un classeur B sur une autre feuille

Bonjour FredOo,

Je viens de regarder ton exemple et j'ai copié ma fonction dans ThisWorkbook, comme toi et ça marche depuis... ma fonction était dans ma feuille "Journal titan" et je l'appelais depuis la feuille où tous les boutons sont. Je ne comprends pas trop pourquoi dans "Journal titan" ça buguait complètement et pourquoi dans ThisWorkbook ça marche mais bon! Ça marche et c'est fantastique.

Merci pour ton dernier ajout sur la fonction, tout marche à merveille...