Copier Valeurs et liens hypertexte

jerome pb excel

XLDnaute Nouveau
Bonjour le Forum,
Pour coller les valeurs d'une ligne, j'utilise le code ci-dessous qui fonctionne très bien :

Code:
Workbooks(NomFichierSource).Sheets("Liens_CR").Rows(15).Copy = Workbooks(NomFichier).Sheets("REALISE").Cells(i, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

Par contre, sur cette ligne, j'ai aussi des liens hypertexte qui du coup ne fonctionne plus (colonnes AC:AF).
Je ne sais pas comment copier les valeurs (sans les formules) mais aussi avec les liens hypertexte. Pouvez vous m'aider ?
 

kjin

XLDnaute Barbatruc
Re : Copier Valeurs et liens hypertexte

Bonjour,
Essaie
Code:
With Workbooks(NomFichier).Sheets("REALISE")
    Workbooks(NomFichierSource).Sheets("Liens_CR").Rows(15).Copy .Cells(i, 1)
        With .Rows(i)
            .Value = .Value
        End With
End With
Cela devrait supprimer les formules en préservant les liens
A+
kjin
 

jerome pb excel

XLDnaute Nouveau
Re : Copier Valeurs et liens hypertexte

Bonjour à tous, Merci kjn pour la réponse,

Les liens hypertexte sont maintenant bien présent, les formules ne sont pas présente, mais parcontre les valeurs ne sont plus présente non plus (elles sont à 0)

Je voudrais aussi que le format des celulless ne soit pas conservé.
 
Dernière édition:

jerome pb excel

XLDnaute Nouveau
Re : Copier Valeurs et liens hypertexte

Re,

j'ai essayé avec un autre code, en séparant les liens hypertexte des autres valeurs.
n.les liens hypertexte sont bien copié, les valeurs (uça marche bien pour 1 cellule, mais je n'arrive pas a étendre ma selectioniquement)
Pouvez vous m'aider ??

Voici mon code
Sub Vers_Réalisé()

Dim Chemin As String
Dim NomFichier As String
Dim NomFichierEtChemin As String
Dim NomFichierSource As String

Dim addLien As String, sLien As String, NomFeuil As String
Dim vdate As Date, Montant As String ' Montant As Double ??


Application.ScreenUpdating = False
On Error Resume Next
NomFichierSource = ActiveWorkbook.Name

Chemin = Sheets("Liens_CR").Range("A2")
NomFichierEtChemin = Chemin & "Realisé-Test" & ".xlsm"
NomFichier = "Realisé-Test" & ".xlsm"


addLien = Workbooks(NomFichierSource).Sheets("Liens_CR").Range("AD15").Hyperlinks(1).Address ' A Appliquer à : range.("AC15:AH15")
sLien = Workbooks(NomFichierSource).Sheets("Liens_CR").Range("AD15").Hyperlinks(1).TextToDisplay 'A Appliquer à : range.("AC15:AH15") 'Liens hypertexte
Renseignemnt = Workbooks(NomFichierSource).Sheets("Liens_CR").Range("A15:AB15") 'A Appliquer à : range.("A15:AB15") ' Valeurs uniquement

'Application.ScreenUpdating = False
Workbooks.Open Filename:=NomFichierEtChemin

'For i = 0 To 29 'For i NOK car copie toujours la même
With Sheets("REALISE")
.Activate
dl = .Range("A65536").End(xlUp).Row + 1
.Cells(dl, 30).Hyperlinks.Add .Cells(dl, 30), addLien, , , sLien ' A Appliqyer à 30 à 35 (colonne AB = 30)
.Cells(dl, 1) = Renseignemnt ' A Appliquer à : 1 à 29
End With
'Next i


End Sub
 

Discussions similaires

Réponses
2
Affichages
149
Réponses
5
Affichages
175

Statistiques des forums

Discussions
312 488
Messages
2 088 840
Membres
103 972
dernier inscrit
steeter