Copier plusieurs cellule dans un autre classeur

Salut le forum

Une petit question, Je voudrai copier des cellules dans un autre classeur déjà ouvert (le nom du fichier change a chaque transfert) faut donc pouvoir choisir le fichier.

Voici mon code:

Sub copie_sur_liste()
'
' copie_sur_liste Macro
'
'
    Range("A15:K30").Select
    Selection.Copy
nomFichier = Application.GetOpenFilename
If nomFichier = False Then
    Exit Sub
Else
    On Error Resume Next
    Workbooks.Open (nomFichier)
    Set nomListePiece = GetObject(nomFichier)
End If
    Sheets("débitage").Select
    Range("A15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub

Ce code permet de copier et de coller dans un autre classeurs mais celui-ci doit être fermer, ce qui m'ennuye.

Quelqu'un pourrai t'il me dire ce que je dois modifier pour y arriver.

Je vous remercie d'avance.

Amicalement

Didier

bonjour,

à rajouter à la fin:

nomListePiece.save
nomListePiece.close

est-ce que c'est bien ça que tu voulais faire?

Salut forum, hello Math,

Je te remercie de ta réponse mais ce n'est pas ca que je désire, la tu ma donner une code pour enregistrer et fermer la liste après copie.

Moi ce que je désire, c'est pouvoir copier la sélection dans une fichier déjà ouvert, ou si tel n'est pas le cas l'ouvrir.

Merci de votre réponse.

Bonne journée

Amicalement

Dideir

Bonjour,

j'ai créé une function pour tester si le classeur est déja ouvert:

Public Function TesteSiOuvert(NomDuClasseur As String) As Boolean
    Dim Classeur As Workbook

    For Each Classeur In Workbooks
        If Classeur.Name = NomDuClasseur Then
            TesteSiOuvert = True
            GoTo fin
        End If
    Next Classeur
    TesteSiOuvert = False
fin:
End Function

ensuite fait un test dans ton code, si la fonction retourne vrai, active le classeur sinon ouvre le:

Sub copie_sur_liste()
    Dim NomClasseur As Workbook

    Range("A15:K30").Select
    Selection.Copy
    nomFichier = Application.GetOpenFilename
    If nomFichier = False Then
        Exit Sub
    Else
        Set NomClasseur = GetObject(nomFichier)
        If TesteSiOuvert(NomClasseur.Name) Then
            NomClasseur.Activate
        Else
            Workbooks.Open NomClasseur.Name
        End If
    End If
    Sheets("débitage").Select
    Range("A15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Set NomClasseur = Nothing
End Sub

est-ce que c'est plus dans ce sens que tu voulais aller?

Hello le forum

Oui je crois bien que c'est ce que je désire,

j'ai juste un problème, ca ne fonctionne pas.

J'ai bien copier les 2 codes dans un modules,

je lance la macro copie_sur_liste, et j'ai le choix d'un fichier, mais ensuite plus rien ne se passe,

Pourrai tu me dire pourquoi, ou ce que je fait faux.

Je te remercie d'avance.

Dideir

c'est mon erreur j'avais mal utilisé l'objet WorkBook, voici le code corrigé

Sub copie_sur_liste()
    Dim NomFichier As String

    Range("A15:K30").Select
    Selection.Copy
    NomFichier = Application.GetOpenFilename
    If NomFichier = "Faux" Then
        Exit Sub
    Else
        If TesteSiOuvert(NomFichier) Then
            Workbooks(NomFichier).Activate
        Else
            Workbooks.Open NomFichier
        End If
    End If
    Sheets("débitage").Select
    Range("A15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub

Hello Math,

Désolé de ma réponse tardive, Alors après essai, y a encore un petit problème, Quand le fichier de destination est fermée, ca fonctionne très bien, mais qand le fichier est ouvert, j0ai une boite de dialogue, m'informant que le ficher est déja ouvert, Si vous l'ouvrez à nouveau, toutes vos modification seront perdu, voulez vous l'ouvrir a nouveau? oui, non.

Que je réponde oui ou non, j'ai une ereur VBA.

Comme tu as corrigé le code, n'a tu pas modifier le Public Function et oublier de me le réenvoyer?

Merci pour ta patience.

Didier

Bonjour Didier,

le code fonctionne si les deux classeurs sont ouvert dans la même instance d'excel. Si le classeur est ouvert dans une autre instance que le fichier qui lance la macro, ma fonction TesteSiOuvert ne le détecete pas et l'ouvre a nouveau. Je cherche un moyen pour contourner ce problème mais pour l'instant, essaie d'ouvrir les deux classeurs dans la même instance et dis moi si ça marche

Math

Hello,

le code fonctionne si les deux classeurs sont ouvert dans la même instance d'excel.

ca veut bien dire n'avoir qu'un excel ouvert?

J'ai essayer avec un seul excel ouvert et les 2 fichier dans le même dossier, rien n'y fait. avec le fichier fermée ca fonctionne masi quand il est déjà ouvert ca marche pas...

J'ai une erreur en li 27, col 13 soit : Workbooks.Open NomFichier

Ce qui me semble suspect (mais j'y connais pas grand chose) c'est de ne pas avoir les meme nom (NomDuClasseur) et (NomFichier)

MERCI de ton aide

Bonne journée

Didier

reBonjour Didier,

désolé je suis pas toute réveillé encore ce matin.

bon disont qu'on oublie pour l'instant le fait que le classeur peu être dans une autre instance de Excel, on est pas obliger de tester si le classeur est déjà ouvert. Quand on utilise Workbook.open, excel ouvre le fichier s'il n'est pas ouvert ou le sélectionne s'il est ouvert. Donc pas besoin de fonction TesteSiOuvert. Le code aurait l'air de ça:

Sub copie_sur_liste()
    Dim NomFichier As String
    Dim ClasseurSource As Workbook
    Dim ClasseurDestination As Workbook

    Set ClasseurSource = ActiveWorkbook

    NomFichier = Application.GetOpenFilename
    If NomFichier = "Faux" Then
        Exit Sub
    Else
        Workbooks.Open NomFichier
    End If

    Set ClasseurDestination = ActiveWorkbook

    ClasseurSource.Activate
    Range("A15:K30").Select
    Selection.Copy

    ClasseurDestination.Activate
    Sheets("débitage").Select
    Range("A15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Set ClasseurSource = Nothing
    Set ClasseurDestination = Nothing
End Sub

Hello,

Je crois que l'on approche du but.

Je n'ai plus d'erreur VBA, quand le fichier est fermée fonctionne tip-top, Par contre quand le fichier est ouvert j'ai toujours la même boite de dialogue, m'informant que le ficher est déja ouvert, "Si vous l'ouvrez à nouveau, toutes vos modification seront perdu, voulez vous l'ouvrir a nouveau? oui, non. "

Si je clic sur oui c'est ensuite tout bon.

Mais pourquoi j'ai cette question, puisque je ne veux pas le rouvrir, mais juste le sélectionner, il est déjà ouvert,

Merci de ton aide et désolé, je ne comprend pas beaucoup a tout ses codes.

Bonjour Gepetto3,

j'ai testé en excel 2000 et ça fonctionne, peut-être qu'avec 2007 il demande une confirmation. Pour contourner le problème on ramène la fonction TesteSiOuvert:

Sub copie_sur_liste()
    Dim NomFichier As String
    Dim NomClasseur As String
    Dim ClasseurSource As Workbook
    Dim ClasseurDestination As Workbook

    Set ClasseurSource = ActiveWorkbook

    NomFichier = Application.GetOpenFilename
    If NomFichier = "Faux" Then
        Exit Sub
    Else
        NomClasseur = IsoleNom(NomFichier)

        If TesteSiOuvert(NomClasseur) Then
            Workbooks(NomClasseur).Activate
        Else
            Workbooks.Open NomFichier
        End If
    End If

    Set ClasseurDestination = ActiveWorkbook

    ClasseurSource.Activate
    Range("A15:K30").Select
    Selection.Copy

    ClasseurDestination.Activate
    Sheets("débitage").Select
    Range("A15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Set ClasseurSource = Nothing
    Set ClasseurDestination = Nothing
End Sub

la fonction TesteSiOuvert:

Public Function TesteSiOuvert(NomDuClasseur As String) As Boolean
    Dim Classeur As Workbook

    For Each Classeur In Workbooks
        If Classeur.Name = NomDuClasseur Then
            TesteSiOuvert = True
            GoTo fin
        End If
    Next Classeur
    TesteSiOuvert = False
fin:
End Function

et une fonction pour isoler le nom du classeur

Public Function IsoleNom(NomFichier) As String
    Dim NomClasseur As String
    Dim PosSlash As Integer

    For i = Len(NomFichier) To 1 Step -1
        If Mid(NomFichier, i, 1) = "\" Then
            PosSlash = i
            GoTo suivant
        End If
    Next i
suivant:
    IsoleNom = Right(NomFichier, Len(NomFichier) - PosSlash)
End Function

avec ça il ne devrait plus y avoir de problème

bonne journée

Hello,

Cool, super un grand pour ton aide, c'est exactement ce que je désirais.

Bonne journée

Amicalement

Didier

Rechercher des sujets similaires à "copier classeur"