VBA excel，工作表复制但超链接已更改答案

【问题标题】：VBA excel, sheet copy but hyperlink is changedVBA excel，工作表复制但超链接已更改
【发布时间】：2018-06-11 09:11:04
【问题描述】：

当我尝试将整个工作表复制到另一个工作表时，一切都很好，除了超链接更改为以“........\”开头，而不是在带有超链接的单元格中使用“http:\”。

复制方法很简单。我不知道为什么会这样。以下是我的简单代码，将 temp1Workbook 的工作表“temp1sheet”复制到 PrimaryWorkbook 的工作表“LatestData”。

'   copy data into the "master file"
Windows(temp1Workbook).Activate
Sheets(temp1Sheet).Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'   paste result, now there is a fresh list of Active
Windows(PrimaryWorkbook).Activate
Sheets("LatestData").Select
Range("A1").Select
ActiveSheet.Paste

提前感谢您的建议和帮助。

【问题讨论】：

我发现原始表的设置有一些特殊之处。当我尝试编辑超链接时，它也以“../../..”开头。但是当它被点击时它可以到达链接。不知道是什么设置。最后我必须根据规则重新编写目标表中的超链接。无论如何，谢谢大家的回答，我学到了很多关于 VBA 的常规用法 :-)

标签： vba excel hyperlink

【解决方案1】：

我认为您几乎不需要对代码进行修改。更好的方法是创建一个变量并传输单元格值并粘贴到所需的位置。

例如，

If Worksheets("Sheet1").Range("A1).Value > "" Then

    Dim NewHLnk As String

    If Worksheets("Sheet1").Range("A1").Hyperlinks.Count = 1 Then

    NewHLnk = Worksheets("Sheet1").Range("A1").Hyperlinks(1).Address 

    Worksheets("Sheet2").Range("A1").Hyperlinks.Add Anchor:=Worksheets("Sheet2").Range("A1), Address:=Worksheets("Sheet2").Range("A1") 
    Worksheets("Sheet2").Range("A1").Hyperlinks(1).Address = NewHLnk  

    End If
 End if

注意：需要将目标单元格变成超链接单元格。

希望对你有所帮助。

【讨论】：

Worksheets("Sheet1").Range("A1).Value > "" 然后还是不见了"

【解决方案2】：

将工作表的整个部分从一个工作簿复制到另一个工作簿时，我建议您将包含数据的实际列从一个工作表复制到另一个工作表的相应列。这可确保您捕获所有格式和超链接。

另外，复制后，我建议您只重新复制值，因为如果您的源工作表中有引用源工作簿中其他工作表的公式，那么目标工作表中将有跨工作簿公式引用如果不需要，最好避免。

恕我直言，通常最好避免在代码中使用.Activate 和对活动工作簿/工作表的引用，除非您希望用户以某种方式与工作表进行交互。仅在代码中操作工作表内容时，最好使用对工作簿/工作表对象本身的引用。

代码如下：

'// Get reference to source worksheet to be copied
Dim shtFrom As Worksheet
Set shtFrom = Application.Workbooks(temp1Workbook).Sheets(temp1Sheet)

'// Get reference to destination worksheet
Dim shtTo As Worksheet
Set shtTo = Application.Workbooks(PrimaryWorkbook).Sheets("LatestData")

'// Get the address of the last used cell in the source worksheet
Dim sLastCell As String
sLastCell = shtFrom.UsedRange.SpecialCells(xlCellTypeLastCell).Address

'// References to the range (of columns) to be copied from / to
Dim rFrom As Range
Dim rTo As Range

'// Get the full range of columns to be copied (col 1 to last used col)
Set rFrom = shtFrom.Range("A1:" & sLastCell).EntireColumn

'// Get the destination columns (i.e. same columns of destination worksheet)
Set rTo = shtTo.Range(rFrom.Address)

'// Clear the destination worksheet of all content
shtTo.Cells.Clear

'// Copy the source columns
rFrom.Copy

'// Paste all first to get formats and hyperlinks etc
rTo.PasteSpecial xlPasteAll

'// Overwrite all formulas with values to ensure no workbook cross-references
rTo.PasteSpecial xlPasteValues

【讨论】：