Copier le contenu d'une cellule dans une autre feuille par macro ???

martial58

XLDnaute Junior
Bonjour à tous.

J'ai un tableau de calibres avec différentes colonnes de données.

La première colonne est la référence du calibre.

Pour chaque calibre je dois créer une fiche de suivi.

J'aimerai donc avoir une macro, lancée par un bouton, qui lorsqu'une cellule de la colonne référence de mon tableau est sélectionnée, s'ouvre alors un fichier de base, vierge, dans lequel on vient copier le nom du calibre dans une cellule (A2 par exemple)

Ensuite, cette fiche doît être enregistrée automatiquement en utilisant toujours la référence du calibre comme nom de fichier.

Enfin, il faudrait q'un lien hypertexte vers cette fiche soit automatiquement créé au niveau de la cellule sélectionnée de mon tableau.

Comment peut-on faire ?

Merci.
 
Dernière édition:

martial58

XLDnaute Junior
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

Bonjour.

Ci-joint les deux fichiers.

D'avance merci.
 

Pièces jointes

  • fiche vierge.xls
    25.5 KB · Affichages: 243
  • Base calibres.xls
    15.5 KB · Affichages: 279
  • Base calibres.xls
    15.5 KB · Affichages: 286
  • Base calibres.xls
    15.5 KB · Affichages: 284
Dernière édition:

Fred0o

XLDnaute Barbatruc
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

Voila Martial, je t'ai fait un bout de programme, je pense que ça doit correspondre à ton besoin.
 

Pièces jointes

  • Base calibres.xls
    25.5 KB · Affichages: 387
  • Base calibres.xls
    25.5 KB · Affichages: 399
  • Base calibres.xls
    25.5 KB · Affichages: 392

martial58

XLDnaute Junior
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

Bonjour et merci, ça fonctionne !

Par contre, au niveau de la création du lien hypertexte je n'arrive pas à indiquer le répertoire.

Comment fonctionne la syntaxe de cette fonction ?

C'est bien hyperlink(le lien vers le fichier,le nom qui doit apparaitre)

A quoi servent les """ dans cette formule ? => "=hyperlink(""" & NomFiche & """,""" & NomCalibre & """)"

Merci.
 

martial58

XLDnaute Junior
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

C'est bon, j'ai trouvé quelle syntaxe employer ! : =hyperlink(""" & Repertoire & NomFiche & """,""" & NomCalibre & """)

En testant la macro je me suis posé une question.

Serait-il possible de transférer toutes les données tel que la date de la vérification, la personne en charge de la vérification, les cotes à mesurer et les résultats de mesure ?

Je pense qu'il suffit d'appliquer la même opération que dans la macro proposée pour chaque colonne, mais mon soucis est de placer toutes les dates et résultats dans la fiche sans écraser les anciennes valeurs ...

Il faut que je conserve l'historique des vérifications périodiques.

Là, je ne vois pas comment faire ????

Si vous avez une idée.

Merci
 

Fred0o

XLDnaute Barbatruc
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

Bonsoir Martial,
Ci-dessous le début du code, tu n'as plus qu'à le compléter comme tu le souhaites. Je n'ai pas tout fait pour 2 raisons :
1° - Il faut bien que tu travailles un peu et que tu comprennes comment ça fonctionne.
2° - Il n'y a aps une grande cohérence entre l'intitulé des valeurs dans Base calibres et la fiche.

Bon courage et A+
 

Pièces jointes

  • Base calibres.xls
    31.5 KB · Affichages: 218
  • Base calibres.xls
    31.5 KB · Affichages: 230
  • Base calibres.xls
    31.5 KB · Affichages: 231

martial58

XLDnaute Junior
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

Bonjour et encore merci !

Je vais continuer sur la base de ton fichier.

Par contre, comment peut-on gérer les historiques de contrôle ?

Cette année je vais contrôler mes calibres et créer la fiche en même temps.

La fiche sera renseignée, ainsi que les résultats de vérification pour l'année courante.

Quand je vais refaire un contrôle d'ici deux ans ou 1 an selon les calibres, il faut que je conserve ces données et que les nouveaux résultats soit consignés dans les lignes en dessous.

En théorie, il faut je pense qu'au moment du transfert des résultats, la date de contrôle soit vérifiée dans la cellule de la fiche de suivi et si elle est différente copier les nouvelles données en dessous et ainsi de suite à chaque nouveau contrôle.

Par contre, je ne vois pas du tout comment traduire cela en langage macro ...

Merci d'avance pour votre aide.

EDIT :

Je viens de voir que cette fonction existait dans ta macro.

Sauf erreur de ma part c'est cette partie là qui gère l'empilage des données :


With Workbooks(NomBase).Worksheets(NomFeuille)
Range("A8").Value = NomCalibre ' Nom du calibre
Range("Q4").Value = .Cells(LigneRef, 2).Value ' Classe
Range("D26").Select
While ActiveCell.Offset(0, -3).Value <> ""
ActiveCell.Offset(2, 0).Select
Wend
ActiveCell.Offset(0, -3).Value = .Cells(LigneRef, 9).Value ' Date d'étalonnage
ActiveCell.Value = .Cells(LigneRef, 11).Value ' Nom opérateur
ActiveCell.Offset(0, 11).Value = .Cells(LigneRef, 10).Value
Endwith
 
Dernière édition:

Fred0o

XLDnaute Barbatruc
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

En fait, il suffit de rajouter une condition (en rouge) :

With Workbooks(NomBase).Worksheets(NomFeuille)
Range("A8").Value = NomCalibre ' Nom du calibre
Range("Q4").Value = .Cells(LigneRef, 2).Value ' Classe
Range("D26").Select
While ActiveCell.Offset(0, -3).Value <> ""
ActiveCell.Offset(2, 0).Select
Wend
If ActiveCell.Offset(0, -3).Value <> .Cells.(LigneRef, 9).Value then
ActiveCell.Offset(0, -3).Value =.Cells.(LigneRef, 9).Value ' Date d'étalonnage
ActiveCell.Value = .Cells(LigneRef, 11).Value ' Nom opérateur
ActiveCell.Offset(0, 11).Value = .Cells(LigneRef, 10).Value
...
...
End if
Endwith

ça devrait fonctionner.
A+
 

martial58

XLDnaute Junior
Re : Copier le contenu d'une cellule dans une autre feuille par macro ???

Bonjour !

La macro fonctionne :

Public NomCalibre As String, NomBase As String, NomFeuille As String, NomFiche As String, LigneRef As Integer

Const Repertoircal = "S:\LOGICIELS QUALITE\QUALITE DEVELOPPEMENT\Moyens de Choc & Calibres\CALIBRE\Plan Dernier indice\"
Const Repertoire = "R:\Référentiel de surveillance\QR-qualité réception\Gestion des Moyens de Contrôle\"



Sub cree_fiche2()
Application.DisplayAlerts = False
ChDir (Repertoire)
NomBase = ActiveWorkbook.Name
NomFeuille = ActiveSheet.Name
NomCalibre = Cells(ActiveCell.Row, 1).Value
LigneRef = ActiveCell.Row
On Error GoTo Fichier_Vierge
Workbooks.Open Filename:=Repertoire & NomCalibre & ".xls"
On Error GoTo 0
With Workbooks(NomBase).Worksheets(NomFeuille)
Range("A8").Value = NomCalibre ' Nom du calibre
Range("A12").Value = .Cells(LigneRef, 8).Value ' Emplacement
Range("O8").Value = .Cells(LigneRef, 31).Value ' Fréquence
Range("E25").Value = .Cells(LigneRef, 14).Value ' C1
Range("G25").Value = .Cells(LigneRef, 16).Value ' C2
Range("I25").Value = .Cells(LigneRef, 18).Value ' C3
Range("K25").Value = .Cells(LigneRef, 20).Value ' C4
Range("M25").Value = .Cells(LigneRef, 22).Value ' C5
Range("E10").Formula = "=hyperlink(""" & Repertoircal & NomCalibre & ".pdf" & """,""" & "Plan calibre" & """)"
Range("D26").Select
While ActiveCell.Offset(0, -3).Value <> ""
ActiveCell.Offset(2, 0).Select
Wend
If ActiveCell.Offset(0, -3).Value <> .Cells(LigneRef, 9).Value Then
ActiveCell.Offset(0, -3).Value = .Cells(LigneRef, 9).Value ' Date d'étalonnage
ActiveCell.Value = .Cells(LigneRef, 11).Value ' Nom opérateur
ActiveCell.Offset(0, 11).Value = .Cells(LigneRef, 10).Value ' Constat / Décision
ActiveCell.Offset(0, 13).Value = .Cells(LigneRef, 32).Value ' Date prochain étalonnage
ActiveCell.Offset(0, 1).Value = .Cells(LigneRef, 15).Value ' mesure C1
ActiveCell.Offset(0, 3).Value = .Cells(LigneRef, 17).Value ' mesure C2
ActiveCell.Offset(0, 5).Value = .Cells(LigneRef, 19).Value ' mesure C3
ActiveCell.Offset(0, 7).Value = .Cells(LigneRef, 21).Value ' mesure C4
ActiveCell.Offset(0, 9).Value = .Cells(LigneRef, 23).Value ' mesure C5

' ^ ^
' | |
' ----------------- --------------------------------------------------
' | |
' Continuer ainsi de suite avec sur la partie droite les coordonnées dans la base calibres et dans la partie gauche,
' les coordonnées dans la fiche.

End If
End With
NomFiche = NomCalibre & ".xls"
ActiveWorkbook.SaveAs Filename:=Repertoire & NomFiche
ActiveWorkbook.Close
Cells(ActiveCell.Row, 1).Formula = "=hyperlink(""" & Repertoire & NomFiche & """,""" & NomCalibre & """)"
Fichier_Vierge:
If Err.Number <> 0 Then
Workbooks.Open Filename:=Repertoire & "fiche de suivi vierge.xls"


Par contre dans le cas où la date est identique et que je relance la macro les données se recopient en dessous comme pour une nouvelle date.

Comment éviter celà ?

J'ai une autre question.

Dans ma fiche de suivi j'ai un lien hypertexte vers le plan du calibre.

Existe-t-il une solution pour afficher la miniature de ce fichier (plan de la pièce en pdf) plutôt que du texte ?

Merci.
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote