Copier cellule d'un Excel dans un autre fichier Excel dans d'autre cellule différente

[kisscool25]

Bonjour,

Je vous expose mon problème :

J'ai un fichier Excel nommé "ENR17 suivi des soins en cave PPNC-V3.xlsx" qui me sert a saisir des informations sur uniquement 1 ligne
un deuxième fichier nommé "Fichier listing2.xlsx" qui lui doit collecter ces informations

Je ne suis pas un expert en macro donc je me permet de faire appel a vos connaissance.

Le but étant de pouvoir copier les cellules de fichier "ENR17...." dans le deuxième mais a la suite des informations déjà existante.
Mais aussi de pouvoir effectuer une correspondance entre les colonnes du premier fichier et du deuxième fichier comme indiqué dans mon fichier joint.

Le tous sans que je sois obligé d'ouvrir le fichier "Fichier listing..."

je vous joint mes deux fichiers

d'avance merci de votre aidre

Cordialement

KissCool

 

[Robert]

Re : Copier cellule d'un Excel dans un autre fichier Excel dans d'autre cellule diffé

Bonsoir Kisscool, bonsoir le forum,

Sans ouvrir le classeur destination je ne sais toujours pas faire ! Le code ci-dessous fait ça de manière transparente. Le classeur destination Fichier listing2.xlsx est ouvert, renseigné, sauvé puis refermé sans que l'utilisateur ne s'en aperçoive pratiquement...
Code à placer dans un module standard du classeur source ENR17 suivi des soins en cave PPNC-V3.xlsm :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim LI As Long 'déclare la variable LI (LIgne)
Dim TCD() As Variant 'déclare la variable TCD (Tableau des Correspondances des Destination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set OS = CS.Sheets("soins") 'définit l'onglet source OS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("Fichier listing2.xlsx") 'définit le classeur destination CD (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 'efface l'erreur
    Workbooks.Open (CA & "Fichier listing2.xlsx") 'ouvre le classeur "Fichier listing2.xlsx"
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("Feuil1") 'définit l'onglet destination OD
LI = OD.Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la ligne LI
'définit le tableau des corespondances des destinations TCD (13 éléments de 0 à 12)
TCD = Array(3, 17, 18, 2, 19, 20, 1, 13, 15, 21, 22, 23, 16)
For I = 1 To 13 'boucles sur les 13 colonnes des données
    'renvoie dans la cellule ligne LI, colonne TCD(I-1) de OD, la valeur ligne 8 colonne I de OS
    OD.Cells(LI, TCD(I - 1)).Value = OS.Cells(8, I).Value
Next I 'prochaine colonne de la boucle
CD.Close True 'ferme le classeur destination CD en enregistrant les modifications
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub