[Excel] Lien entre feuille

Résolu
J0K0 -  
Bonsoir !

J'ai un petit soucis, j'ai créé une macro qui me sert à copier le contenu d'une cellule d'une feuille 1, la coller dans une feuille récapitulatif. J'aimerais après avoir fait ça créer un lien vers cette même feuille 1. Je n'y arrive qu'à moitier. Je bloc à : désigner la feuille utilisée.

Voici la macro :
Sub Macro7()
ActiveSheet.Select
Range("A6:AL6").Copy
Sheets("recapitulatif").Select
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Range("A5:AL5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A5:AL5").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Workbook, _
SubAddress:="'3'!A1"
End Sub

Merci !
Configuration: Windows XP Internet Explorer 6.0

3 réponses

  • Votes
  • Date
  • Date décroissante
  1. J0K0 Auteur
    Sub Macro8()
    Dim rngSource As Range

    ActiveSheet.Select
    Range("A6:AL6").Copy
    Set rngSource = Selection

    Sheets("recapitulatif").Select
    Rows("5:5").Select
    Selection.Insert Shift:=xlDown
    Range("A5:AL5").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    Range("A5:AL5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=rngSource.Worksheet.Name & "!" & rngSource.Address, TextToDisplay:=rngSource.Worksheet.Name

    Set rngSource = Nothing
    End Sub

    Affaire résolue.
    1. J0K0 Auteur
      RE, je ne comprends pas,ça ne marchequ'à moitier...je m'entends :
      Sub Macro7()
      ActiveSheet.Select
      Range("A6:AL6").Copy
      Page = ActiveSheet.Name Sheets("recapitulatif").Select
      Rows("5:5").Select
      Selection.Insert Shift:=xlDown
      Range("A5:AL5").Select
      With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlBottom
      .WrapText = False
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      End With
      Selection.Merge
      Range("A5:AL5").Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      Selection.Borders(xlInsideVertical).LineStyle = xlNone
      Selection.Interior.ColorIndex = xlNone
      ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Workbook & Page
      End Sub

      La copie se fait bien, le lien se fait, mais lorsque je teste le lien j'ai une erreur :
      Impossible d'ouvrir le fichier spécifique.

      J'ai tendance à dire normal, faudrait que j'arrive à récupérer le nom de la feuille dans ce lien et qu'il soit unique ....

      Une aide please ??
      1. J0K0 Auteur
        Sub Macro8()
        Dim rngSource As Range

        ActiveSheet.Select
        Range("A6:AL6").Copy
        Set rngSource = Selection

        Sheets("recapitulatif").Select
        Rows("5:5").Select
        Selection.Insert Shift:=xlDown
        Range("A5:AL5").Select
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With
        Selection.Merge
        Range("A5:AL5").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Interior.ColorIndex = xlNone

        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=rngSource.Worksheet.Name & "!" & rngSource.Address, TextToDisplay:=rngSource.Worksheet.Name

        Set rngSource = Nothing
        End Sub

        Affaire résolue.

        Discussions similaires

        Copier un lien instagram
        alaurore

        7 réponses
        Retrouver liens copiés sur le téléphone
        SAMA

        2 réponses
        copie d'un lien dans le navigateur internet
        Ulysse Orseau

        4 réponses