Lien hypertextes

Bonjour,

le but et de cocher une checkbox et de copier la ligne dans une feuille qui me sert sert de récapitulatif. Cela fonctionne plutôt bien grâce à vos conseils, mais dans l'une des cellules qui doit être copier il y a un lien hypertextes qui n'est plus "actif" une fois copier dans la feuille recap "DEVIS" dans les lignes ci-dessous. Merci d'avance

Private Sub CheckBox1_Click()

If CheckBox1 = True Then

num = Sheets("DEVIS").Range("C1048576").End(xlUp).Row + 1

Sheets("DEVIS").Range("C" & num).Value = Sheets("1 - ALLIA").Range("C4").Value

Sheets("DEVIS").Range("D" & num).Value = Sheets("1 - ALLIA").Range("D4").Value

Sheets("DEVIS").Range("E" & num).Value = Sheets("1 - ALLIA").Range("E4").Value

Sheets("DEVIS").Range("F" & num).Value = Sheets("1 - ALLIA").Range("F4").Value

Sheets("DEVIS").Range("G" & num).Value = Sheets("1 - ALLIA").Range("G4").Value

Sheets("DEVIS").Range("H" & num).Value = Sheets("1 - ALLIA").Range("H4").Value

Sheets("DEVIS").Range("I" & num).Value = Sheets("1 - ALLIA").Range("I4").Value

Sheets("DEVIS").Range("J" & num).Value = Sheets("1 - ALLIA").Range("J4").Value

Sheets("DEVIS").Range("K" & num).Value = Sheets("1 - ALLIA").Range("K4").Value

Sheets("DEVIS").Range("L" & num).Value = Sheets("1 - ALLIA").Range("L4").Value

Sheets("DEVIS").Range("M" & num).Value = Sheets("1 - ALLIA").Range("M4").Value

Sheets("DEVIS").Range("N" & num).Value = Sheets("1 - ALLIA").Range("N4").Value

Sheets("DEVIS").Range("O" & num).Value = Sheets("1 - ALLIA").Range("O4").Value

Sheets("DEVIS").Range("P" & num).Value = Sheets("1 - ALLIA").Range("P4").Value

Sheets("DEVIS").Range("Q" & num).Value = Sheets("1 - ALLIA").Range("Q4").Value

End If

End Sub

Bonjour,

On va peut-être commencer par alléger ton code.

Ensuite tu vas joindre ton classeur et nous préciser la cellule qui contient le lien hypertexte qui fait défaut.

Cdlt

Option Explicit
Private Sub CheckBox1_Click()
Dim f1 As Worksheet, f2 As Worksheet
Dim num As Long
    Set f1 = Worksheets("DEVIS")
    Set f2 = Worksheets("1 - ALLIA")
    If CheckBox1 = True Then
        With f1
            num = .Range("C" & Rows.Count).End(xlUp) + 1
            .Range("C" & num & ":Q" & num) = f2.Range("C4:Q4").Value
        End With
    End If
    Set f1 = Nothing: Set f2 = Nothing
End Sub

Re,

Merci Jean Eric de vous pencher sur mon problème !

exemple les cellules N4 O4 P4 de la feuille "1 - ALLIA" (contiennent des liens hypertextes) quant elles se copient sur la feuille "DEVIS"

les liens ne sont plus actif.

Cordialement

Feuille excel ci-joint

Edit : supprimé

Re,

A tester.

Cdlt

Option Explicit
Private Sub CheckBox1_Click()
Dim f1 As Worksheet, f2 As Worksheet
Dim num As Long
    Set f1 = Worksheets("DEVIS")
    Set f2 = Worksheets("1 - ALLIA")
    If CheckBox1 = True Then
        num = f1.Range("C" & Rows.Count).End(xlUp) + 1
        f2.Range("C4:Q4").Copy Destination:=f1.Range("C" & num)
        Application.CutCopyMode = False
    End If
    Set f1 = Nothing: Set f2 = Nothing
End Sub