Copiar Links vba a hoja datos excel

Hola Jaime:

Tengo una macro que me lleva los datos de la mascarilla a otra hoja llamada datos, pero resulta que en la mascara de captura hay vínculos y estos me los lleva como datos, quisiera saber si hay una forma que me copie el link de forma exacta sin desordenar la secuencia de los registros.

Esta asi:

Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
'
strTitulo = "SANOFI"
'
Continuar = MsgBox("Dar de alta el evento?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Datos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Datos")
.Cells(NewRow, 1).Value = ThisWorkbook.Sheets(1).Range("d5")
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("d6")
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets(1).Range("d7")
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets(1).Range("d8")

las celdas (d6,d7 y d8) son vínculos y me los pasa como valor.

Gracias, mil gracias.

Alejandro.

1 Respuesta

Respuesta

Puedes probar

. Cells(NewRow, 2).FormulaR1C1 = ThisWorkbook. Sheets(1). Range("d6"). FormulaR1C1

Pero me parece que en ese caso no te va a copiar la referencia a la Hoja...

Por ejemplo

si en la celda dice =A3+1

te va a copia esa misma formula...(que quiere decir =Datos!A3+1 )

y no =Hoja1!a3+1, por lo que

¿Podrías indicarme como se llama la Sheets(1)?... y que formula hay exactamente en D6, D7 y D8

Hola Jaime, gracias por responder.

La hoja que se refiere Sheets (1) se llama "Datos" y los datos que hay en esas celdas son vínculos, pero a la hora que hace el barrido la macro, me los pasa como datos.

La macro esta exactamente de la siguiente forma:

Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
'
strTitulo = "SANOFI"
'
Continuar = MsgBox("Dar de alta el evento?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Datos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Datos")
.Cells(NewRow, 1).Value = ThisWorkbook.Sheets(1).Range("d5")
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("d6")
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets(1).Range("d7")
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets(1).Range("d8")
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets(1).Range("d9")
.Cells(NewRow, 6).Value = ThisWorkbook.Sheets(1).Range("d10")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(1).Range("d11")
.Cells(NewRow, 8).Value = ThisWorkbook.Sheets(1).Range("d12")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(1).Range("d13")
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets(1).Range("d14")
.Cells(NewRow, 11).Value = ThisWorkbook.Sheets(1).Range("d15")
.Cells(NewRow, 12).Value = ThisWorkbook.Sheets(1).Range("d16")
.Cells(NewRow, 13).Value = ThisWorkbook.Sheets(1).Range("d17")
.Cells(NewRow, 14).Value = ThisWorkbook.Sheets(1).Range("d18")
.Cells(NewRow, 15).Value = ThisWorkbook.Sheets(1).Range("d19")
.Cells(NewRow, 16).Value = ThisWorkbook.Sheets(1).Range("d20")
.Cells(NewRow, 17).Value = ThisWorkbook.Sheets(1).Range("d21")
.Cells(NewRow, 18).Value = ThisWorkbook.Sheets(1).Range("d22")
.Cells(NewRow, 19).Value = ThisWorkbook.Sheets(1).Range("d23")
.Cells(NewRow, 20).Value = ThisWorkbook.Sheets(1).Range("d24")
.Cells(NewRow, 21).Value = ThisWorkbook.Sheets(1).Range("d25")
.Cells(NewRow, 22).Value = ThisWorkbook.Sheets(1).Range("d26")
.Cells(NewRow, 23).Value = ThisWorkbook.Sheets(1).Range("d27")
.Cells(NewRow, 24).Value = ThisWorkbook.Sheets(1).Range("d28")
.Cells(NewRow, 25).Value = ThisWorkbook.Sheets(1).Range("d29")
.Cells(NewRow, 26).Value = ThisWorkbook.Sheets(1).Range("d30")
.Cells(NewRow, 27).Value = ThisWorkbook.Sheets(1).Range("d31")
.Cells(NewRow, 28).Value = ThisWorkbook.Sheets(1).Range("d32")
.Cells(NewRow, 29).Value = ThisWorkbook.Sheets(1).Range("d33")
End With
'
MsgBox "Evento capturado exitosamente.", vbInformation, strTitulo
Limpiar = MsgBox("Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
With ActiveWorkbook.Sheets(1)
.Range("d5").ClearContents
.Range("d6").ClearContents
.Range("d7").ClearContents
.Range("d8").ClearContents
.Range("d9").ClearContents
.Range("d10").ClearContents
.Range("d11").ClearContents
.Range("d12").ClearContents
.Range("d13").ClearContents
.Range("d14").ClearContents
.Range("d15").ClearContents
.Range("d16").ClearContents
.Range("d17").ClearContents
.Range("d18").ClearContents
.Range("d20").ClearContents
.Range("d21").ClearContents
.Range("d22").ClearContents
.Range("d23").ClearContents
.Range("d24").ClearContents
.Range("d25").ClearContents
.Range("d26").ClearContents
.Range("d27").ClearContents
.Range("d28").ClearContents
.Range("d30").ClearContents
.Range("d31").ClearContents
.Range("d32").ClearContents
.Range("d33").ClearContents
End With
Else
End If
'
End Sub

Gracias

Mandame tu archivo si puedes... necesito VER las formulas para ver si hay manera de que se copien los links..

Saludos,

Jaime

[email protected]

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas