[Toutes versions] Archiver infos d'une feuille d'un classeur à un autre + lien hypertexte.

[tompom3108]

Bonjour à tous,
J'ai un petit souci de débutant en vba. J'utilise un code d'archivage d'informations d'une feuille excel à une autre dans un même classeur. Ces informations s'ajoutent dans la feuille de destination. J'aimerai effectuer la même chose avec la feuille de destination située dans un autre classeur (fermé ou ouvert). Tout ce que j'ai essayé n'a pas marché jusqu'ici Si quelqu'un peut me renseigner.

Voici le code que j'utilise actuellement :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub A_infosdevis()
 
Num_Fact = Range("F19").Value
    Date_Fact = Range("L5").Value
        Nom_Client = Range("J13").Value
            Montant_DevisHT = Range("M57").Value
                Montant_DevisTTC = Range("M59").Value
                Indice_Devis = Range("G19").Value
 
Sheets("Stat_Devis").Activate
    Range("A1").Select
If Range("A2").Value <> "" Then ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
 
        ActiveCell.Value = Num_Fact
      ActiveCell.Offset(0, 1).Value = Date_Fact
      ActiveCell.Offset(0, 2).Value = Nom_Client
      ActiveCell.Offset(0, 3).Value = Indice_Devis
      ActiveCell.Offset(0, 4).Value = Montant_DevisHT
      ActiveCell.Offset(0, 5).Value = Montant_DevisTTC
 
    Sheets("Devis").Activate
    ActiveCell.Offset(1, 0).Select
Loop
 
End Sub
 
Après j'aurai une autre question : ce code fait partie d'un autre code d'enregistrement et d'impression d'une feuille "Devis". Est il possible d'ajouter un lien hypertexte à un des éléments archiver ci-dessus avec la feuille "Devis" sauvegardée.
 
Voici le code de suvegarde et d'impression :
 
Sub A_Devis()
 
Do
    Nb_Ex = InputBox("Nombre d'exemplaires (>1) :", "Impression", 2)
    Loop Until Nb_Ex >= 2
If Not (IsNumeric(Nb_Ex)) Then Exit Sub
 
Call A_infosdevis
 
Repertoire = Sheets("Menu").Range("C9").Value
    Num_Fact = Range("F19").Value
    Nom_Client = Range("J13").Value
 
ActiveSheet.Copy
 
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("A1").Select
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("J10").Value = "Duplicata Devis"
 
ActiveWindow.SelectedSheets.PrintOut Copies:=Nb_Ex - 1, Collate:=True
Range("K10").Value = "Devis"
 
Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Repertoire & Num_Fact & " " & Nom_Client & ".xlsx"
ActiveWorkbook.Close
Application.DisplayAlerts = True
 
ThisWorkbook.Activate
 
    Sheets("Menu").Activate
    Range("C10").Value = Range("C10").Value + 1
 
 
 
MsgBox "Le devis n° " & Num_Fact & vbCrLf & " pour le client " & Nom_Client & vbCrLf & " a bien été archivé.", vbInformation + vbOKOnly, "Archivage devis"
 
 
End Sub

Voilà en gros j'aimerai que l'archivage au niveau de

'"ActiveCell Num_Fact.Value = Num_Fact" (ligne 12 du premier code) le Num_Fact ai en plus un lien hypertexte sur la sauvegarde du "Devis" du même "Num-Fact"

J'ai pas l'impression d'être clair ( Bon tapis je tente le coup c'est mon premier message sur un forum .

[tompom3108]

Bon je me réponds... Parfois il faut se poser des questions pour trouver des réponses.
Alors j'ai réussi à envoyer des informations de ma feuille "devis" de mon classeur "modèle devis vba" à la feuille "DP" de mon classeur "devisprovisoire".

voici les codes corrigés :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Sub A_Devis()
 
Do
    Nb_Ex = InputBox("Nombre d'exemplaires (>1) :", "Impression", 2)
    Loop Until Nb_Ex >= 2
If Not (IsNumeric(Nb_Ex)) Then Exit Sub
 
Call A_infosdevis
 
Repertoire = Sheets("Menu").Range("C9").Value
    Num_Fact = Range("F19").Value
    Nom_Client = Range("J13").Value
 
ActiveSheet.Copy
 
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("A1").Select
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("J10").Value = "Duplicata Devis"
 
ActiveWindow.SelectedSheets.PrintOut Copies:=Nb_Ex - 1, Collate:=True
Range("K10").Value = "Devis"
 
Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Repertoire & Num_Fact & " " & Nom_Client & ".xlsx"
ActiveWorkbook.Close
Application.DisplayAlerts = True
 
ThisWorkbook.Activate
 
    Sheets("Menu").Activate
    Range("C10").Value = Range("C10").Value + 1
 
 
 
MsgBox "Le devis n° " & Num_Fact & vbCrLf & " pour le client " & Nom_Client & vbCrLf & " a bien été archivé.", vbInformation + vbOKOnly, "Archivage devis"
 
 
End Sub
 
Sub A_infosdevis()
 
Num_Fact = Range("F19").Value
    Date_Fact = Range("L5").Value
        Nom_Client = Range("J13").Value
            Montant_DevisHT = Range("M57").Value
                Montant_DevisTTC = Range("M59").Value
                Indice_Devis = Range("G19").Value
 
Application.Workbooks.Open "f:\Atest\Devisprovisoire.xlsx"
 
Sheets("DP").Activate
    Range("A1").Select
If Range("A2").Value <> "" Then ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
 
        ActiveCell.Value = Num_Fact
      ActiveCell.Offset(0, 1).Value = Date_Fact
      ActiveCell.Offset(0, 2).Value = Nom_Client
      ActiveCell.Offset(0, 3).Value = Indice_Devis
      ActiveCell.Offset(0, 4).Value = Montant_DevisHT
      ActiveCell.Offset(0, 5).Value = Montant_DevisTTC
 
 
ActiveWorkbook.Saved = False
 
ActiveWorkbook.Close
 
Workbooks("modèle devis vba").Activate
    Sheets("Devis").Activate
    ActiveCell.Offset(1, 0).Select
 
 
End Sub

Cependant j'aimerai pouvoir éviter d'avoir à mettre à jour et à valider l'enregistrement avant activeWorkbook.Close
De plus, J'aimerai trouver un moyen pour que mon Num_Fact archivé dans la feuille "DP" du classeur "Devisprovisoire" soit un lien hypertexte vers la sauvegarde de la feuille "devis" du classeur "modèle devis vba" dans le répertoire "Repertoire = Sheets("Menu").Range("C9").Value"

Si quelqu'un pouvait m'aider avant que j'y passe toutes mes nuits ce serait super merci aux philanthropes.