XL 2010 Copier coller 2 classeur de 2 different classeur.

[tomtom57280]

Bonjour la communauté

Je reviens encore une fois vers vous pour un petit coup de main, j'ai regarder un peu pour essayer par moi-même mais la je sèche un peu tant il y aurais de solution.

J'ai 2 classeur:
Mon premier avec une seule feuille a l'emplacement:
H:\année vierge\Cycle TTH
J'aimerai copier sa feuille 1 par macro dans un autre classeur sur la feuille "CYCLES TTH"
Le bouton se trouvera dans mon 2eme classeur sur la feuille "CYCLES TTH"
Merci d'avance de l'aide que vous me donnerai et bonne journée à tous.

 

[Robert]

Bonjour Tomtom, bonjour le forum,

Il manque le nom du classeur Source dans le code ci-dessous. Tu adapteras...
Le code :

Sub Macro1()
Dim NCS As String 'déclare la variable NCS (Nom du Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accueil)

NCS = "ici il faut le nom du classeur source et son extension"
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("CYCLES TTH") 'définit l'onglet destination OD
CA = "H:\année vierge\Cycle TTH\" 'définit le chemin d'accès CA
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CS = Workbooks(NCS) 'définit le classeur source CS (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CS = Application.Workbooks.Open(CA & NCS) 'définit le classeur source CS (en l'ouvrant)
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
CS.Worksheets(1).UsedRange.Copy OD.Range("A1") 'copy la plage utilisée du premeir onglet du classeur source et la colle dans A1 de l'onglet destination
End Sub

 

[tomtom57280]

Le nom du classeur source est Cycle TTH , H:\année vierge\ est le dossier qui le contient.
Merci pour ta réponse je vais essayer de la transcrire et esperans que j'arrive a l'adapter correctement.
Bonne journée a tous

 

[tomtom57280]

Par contre quand tu dis le nom du classeur source c'est "Cycle TTH" mais son extension correspond à quoi ? La feuil1 ou le nom que je lui donnerai la ou j'ai mes données a copier?
Merci encore

 

[Robert]

Re,

En fonction de la version d'Excel ou du type de classeur que tu utilises, l'extension peut changer.
NCS peut être égale à :
Cycle TTH .xls
Cycle TTH .xlsx
Cycle TTH .xlsm
À toi de voir...

Si je comprends bien, l'onglet destination OD porte le même nom que le classeur source ?! Bizarre...

 

[Arthur.clb]

Bonjour je suis en stage en logistique et j'ai rencontré le même problème que tomtom et je me suis donc fortement inspiré de vos réponses mais il y a toujours un problème lorsque je veux exécuter ma macro :
Sub Extraction()
Dim NCS As String 'Nom du Classeur Source
Dim CD As Workbook 'Classeur Destination
Dim CS As Workbook 'Classeur Source
Dim OD As Worksheet 'Onglet Destination
Dim CA As String 'Chemin d'Accueil
'NCS = "06_juin_19.xlsx" 'nom du classeur source et son extension
Set CD = ThisWorkbook ' classeur destination CD
Set OD = CD.Worksheets("Extraction_données") 'onglet destination OD
CA = "C:\Users\slaur.logistique\Desktop\ARTHUR\transporteur" 'définit le chemin d'accès CA
On Error Resume Next 'gestion des erreurs
Set CS = Workbooks("06_juin_19.xlsx") 'définit le classeur source CS (erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Set CS = Application.Workbooks.Open(CA & "06_juin_19.xlsx") 'définit le classeur source CS (en l'ouvrant)
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
CS.Worksheets(1).UsedRange.Copy OD.Range("A1") 'copie la plage utilisée du premeir onglet du classeur source et la colle dans A1 de l'onglet destination
End Sub

De plus, j'aimerai que le fichier choisit soit le fichier le plus recent présent dans le dossier mais je n'ai aucune idée de comment m'y prendre.
Merci d'avance

 

[Robert]

Bonjour le fil, bonjour le forum,

Il manque un anti-slash à la fin dans le chemin d'accès :

CA = "C:\Users\slaur.logistique\Desktop\ARTHUR\transporteur\"

 

[Arthur.clb]

Bonjour, merci pour votre réactivité le probleme de vient pas d'ici, lorsque que je veux lancer ma macro :
sur cette ligne de code :
CS.Worksheets(1).UsedRange.Copy OD.Range("A1")


Je ne suis toujours pas parvenu à corriger mon erreur

 

[Robert]

Re,

Est-ce que penses parvenir à fournir le fichier qui va bien ? On va pas y passer des jours...

 

[Arthur.clb]

Mon fichier est un fichier vierge il comporte juste la macro qui extrait la feuille d'un autre fichier. Par la suite il y aura des opérations à effectuer dessus mais pour l'instant c'est une feuille vierge

Sub Extraction()
Dim NCS As String 'Nom du Classeur Source
Dim CD As Workbook 'Classeur Destination
Dim CS As Workbook 'Classeur Source
Dim OD As Worksheet 'Onglet Destination
Dim CA As String 'Chemin d'Accueil
'NCS = "06_juin_19.xlsx" 'nom du classeur source et son extension
Set CD = ThisWorkbook ' classeur destination CD
Set OD = CD.Worksheets("Extraction_données") 'onglet destination OD
CA = "C:\Users\slaur.logistique\Desktop\ARTHUR\transporteur\" 'définit le chemin d'accès CA
On Error Resume Next 'gestion des erreurs
Set CS = Workbooks("06_juin_19.xlsx") 'définit le classeur source CS (erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Set CS = Application.Workbooks.Open(CA & "06_juin_19.xlsx") 'définit le classeur source CS (en l'ouvrant)
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
CS.Worksheets(1).UsedRange.Copy OD.Range("A1") 'copie la plage utilisée du premeir onglet du classeur source et la colle dans A1 de l'onglet destination
End Sub

 

[Robert]

Re,

Ho P... ! Je suis fatigué.... Alors l'autre que l'on puisse tester...

 

[Arthur.clb]

Voici le fichier que je voudrai extraire sur une feuille d'un fichier vierge (le fichier vierge sera déjà ouvert)
Mon code du fichier vierge :

Sub Extraction()
Dim NCS As String 'Nom du Classeur Source
Dim CD As Workbook 'Classeur Destination
Dim CS As Workbook 'Classeur Source
Dim OD As Worksheet 'Onglet Destination
Dim CA As String 'Chemin d'Accueil
'NCS = "06_juin_19.xlsx" 'nom du classeur source et son extension
Set CD = ThisWorkbook ' classeur destination CD
Set OD = CD.Worksheets("Extraction_données") 'onglet destination OD
CA = "C:\Users\slaur.logistique\Desktop\ARTHUR\transporteur\" 'définit le chemin d'accès CA
On Error Resume Next 'gestion des erreurs
Set CS = Workbooks("06_juin_19.xlsx") 'définit le classeur source CS (erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Set CS = Application.Workbooks.Open(CA & "06_juin_19.xlsx") 'définit le classeur source CS (en l'ouvrant)
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
CS.Worksheets(1).UsedRange.Copy OD.Range("A1") 'copie la plage utilisée du premeir onglet du classeur source et la colle dans A1 de l'onglet destination
End Sub

 

[Robert]

Re,

Si je comprends bien et d'après ton code, le fichier que tu fournis devrait s'appeler : 06_juin_19.xlsx. Pourquoi tu embrouilles en lui donnant un autre nom ?!... Comment veux-tu qu'on te vienne en aide ? Je passe la main...