Copier contenu cellule d'un fichier vers cellule d'un autre fichier

TiteRoch Messages postés 2 Date d'inscription lundi 4 décembre 2000 Statut Membre Dernière intervention 25 août 2011 - 24 août 2011 à 11:14
TiteRoch Messages postés 2 Date d'inscription lundi 4 décembre 2000 Statut Membre Dernière intervention 25 août 2011 - 25 août 2011 à 15:20
Bonjour,
Je débute en VBA et j'ai un souci avec une macro : j'ai un fichier avec un ensemble de données et je souhaite prendre une partie des données pour les enregistrer dans un fichier "liste" (qui recensent les données principales pour pouvoir ensuite faire une recherche plus facile parmi tous les fichiers) et ensuite enregistrement du fichier dans un dossier nommé.
Mon problème c'est la copie des données d'un fichier vers l'autre fichier.
Je vous laisse le code pour que vous puissiez regarder où sont les erreurs...

Private Sub enregistrement_Click()

fichier = ActiveWorkbook.Name

Workbooks.Open Filename:="W:\METHODES\COMMUN\Liste des CdC outils.xls"

' Boucle pour trouver la première ligne vide et le dernier numéro de CdC

i = 1

Do

i = i + 1

Loop While Worksheets("Liste").Range("A" & i) <> ""

' Remplissage automatique du numéro de CdC

Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
ThisWorkbook.Sheets("Entete").Activate
  
Range("NumeroCdc") = "CDC-OUT-0" & i
  
MsgBox ("Le numéro de ce cahier des charges sera le N° " & i)

' Permettre le remplissage du fichier "liste des CdC outils"

ligne = i

' Copie/Colle NumeroCdC

Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
    ThisWorkbook.Sheets("Entete").Activate
    Range("NumeroCdc").Select
    NumeroCdc = Range("NumeroCdc")
    Windows("Liste des CdC outils.xls").Activate
    Range("A" & ligne).Select
    ActiveCell.FormulaR1C1 = NumeroCdc

' Copie/Colle IndiceCdc

    Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
    ThisWorkbook.Sheets("Entete").Activate
    Range("IndiceCdc").Select
    IndiceCdc = Range("IndiceCdc")
    Windows("Liste des CdC outils.xls").Activate
    Range("B" & ligne).Select
    ActiveCell.FormulaR1C1 = IndiceCdc
    
' Copie/Colle ReferenceOutil

    Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
    ThisWorkbook.Sheets("Entete").Activate
    Range("ReferenceOutil").Select
    ReferenceOutil = Range("ReferenceOutil")
    Windows("Liste des CdC outils.xls").Activate
    Range("C" & ligne).Select
    ActiveCell.FormulaR1C1 = ReferenceOutil
    
' Copie/Colle Designation Outil

    Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
    ThisWorkbook.Sheets("Entete").Activate
    Range("DesignationOutil").Select
    DesignationOutil = Range("DesignationOutil")
    Windows("Liste des CdC outils.xls").Activate
    Range("D" & ligne).Select
    ActiveCell.FormulaR1C1 = DesignationOutil
      
' Copie/Colle DateCdc

    Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
    ThisWorkbook.Sheets("Entete").Activate
    Range("DateCdc").Select
    DateCdc = Range("DateCdc")
    Windows("Liste des CdC outils.xls").Activate
    Range("E" & ligne).Select
    ActiveCell.FormulaR1C1 = DateCdc
       
' Copie/Colle NomRedacteur
    
    Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
    ThisWorkbook.Sheets("Validation").Activate
    Range("nomRedacteur").Select
    nomRedacteur = Range("nomRedacteur")
    Windows("Liste des CdC outils.xls").Activate
    Range("F" & ligne).Select
    ActiveCell.FormulaR1C1 = nomRedacteur
   
    Windows("Liste des CdC outils.xls").Activate
    ActiveWorkbook.Close SaveChanges:=True
    
'SAUVEGARDE
'sauvegarde du Cdc

  
If fichier = "RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls" Then

ActiveWorkbook.SaveAs Filename:="W:\METHODES\COMMUN\Cdc outillage\UPA Articulations\10000 Outil de Presse\CDC outillage presses\CDC-OUT-0" & i & "-" & Range("ReferenceOutil") & "-ind " & Range("IndiceCdc") & ".xls", FileFormat:=xlNormal
 
End If

'sauvegarde en modification de fiche existante
If fichier <> "RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls" Then
   ActiveWorkbook.Save
   ActiveWorkbook.Close
  End If
    

End Sub


Merci d'avance pour votre aide!

2 réponses

VBNoob13 Messages postés 12 Date d'inscription mardi 1 mars 2011 Statut Membre Dernière intervention 5 septembre 2011
24 août 2011 à 11:39
Salut TiteRoch,

Je te conseille de regarder ce site au paragraphe copier-coller,
je pense que ce te sera utile:
http://www.info-3000.com/vbvba/syntheseplusieursclasseurs/index.php

Bon courage

Noobie en auto-apprentissage!!!
0
TiteRoch Messages postés 2 Date d'inscription lundi 4 décembre 2000 Statut Membre Dernière intervention 25 août 2011
25 août 2011 à 15:20
Bonjour,

Merci pour ce lien, c'est vrai que ce document est très utile.

Mais même en regardant ce document, je n'arrive pas à trouver mon erreur...

En fait, ma macro commence à bugger à l'instruction suivante :

Windows("RFL-F-DSS-0309 EN 01 - Tooling Technical Specifications 2.xls").Activate
ThisWorkbook.Sheets("Entete").Activate
Range("NumeroCdc").Select
NumeroCdc = Range("NumeroCdc")
Windows("Liste des CdC outils.xls").Activate
Range("A" & ligne).Select
ActiveCell.FormulaR1C1 = NumeroCdc

Alors que "ligne" correspond à la première ligne vide du fichier "Liste des CdC Outils".

Je pense que c'est un problème de syntaxe.

Merci de votre aide!
0