首页 > 解决方案 > VBA:将数据传输到多个电子表格时如何包含超链接?

问题描述

我正在创建一个数据组织系统。我创建了一个子程序,它将导入一个充满数据的电子表格(sheet1),允许用户将每个条目分类到特定部门(L 列),然后将数据分发到主电子表格(Cumative-bydirectorate),并基于部门分类的相应子表(L 列)。

转移到各种工作表时,我无法保持 A 列中存在的超链接。我不确定要更改什么以将超链接保留在传输的单元格中。

这是我正在使用的代码。它只是粘贴单元格值,而不是嵌入在单元格中的超链接。A 列由数字组成,但每个数字都与一个唯一的超链接相关联

Sub copyrows()

Dim wsMst As Worksheet
Dim wsDpt As Worksheet
Dim wsImp As Worksheet
Dim lSRow As Long
Dim lCol As Long
Dim lMRow As Long
Dim lDRow As Long

Set wsImp = Sheets("sheet1")
Set wsMst = Sheets("Cumulative-bydirectorate")

lSRow = 2

lMRow = WorksheetFunction.CountA(wsMst.Range("$A:$A")) + 1

Do Until wsImp.Cells(lSRow, 1) = ""

    Set wsDpt = Sheets(wsImp.Range("L" & lSRow).Value2)
    lDRow = WorksheetFunction.CountA(wsDpt.Range("$A:$A")) + 1

    For lCol = 1 To 12

        wsMst.Cells(lMRow, lCol) = wsImp.Cells(lSRow, lCol)
        wsDpt.Cells(lDRow, lCol) = wsImp.Cells(lSRow, lCol)

    Next lCol

    wsImp.Rows(lSRow).ClearContents

    lMRow = lMRow + 1
    lSRow = lSRow + 1

Loop
End Sub

标签: excelvba

解决方案


您可以复制并粘贴第一个单元格(A 列):[未测试]

Sub copyrows()

Dim wsMst As Worksheet
Dim wsDpt As Worksheet
Dim wsImp As Worksheet
Dim lSRow As Long
Dim lCol As Long
Dim lMRow As Long
Dim lDRow As Long

Set wsImp = Sheets("sheet1")
Set wsMst = Sheets("Cumulative-bydirectorate")

lSRow = 2

lMRow = WorksheetFunction.CountA(wsMst.Range("$A:$A")) + 1

Do Until wsImp.Cells(lSRow, 1) = ""

    Set wsDpt = Sheets(wsImp.Range("L" & lSRow).Value2)
    lDRow = WorksheetFunction.CountA(wsDpt.Range("$A:$A")) + 1

    wsImp.Cells(lSRow, 1).Copy Destination:=wsMst.Cells(lMRow, 1)
    wsImp.Cells(lSRow, 1).Copy Destination:=wsDpt.Cells(lDRow, 1)

    For lCol = 2 To 12

        wsMst.Cells(lMRow, lCol) = wsImp.Cells(lSRow, lCol)
        wsDpt.Cells(lDRow, lCol) = wsImp.Cells(lSRow, lCol)

    Next lCol    

    wsImp.Rows(lSRow).ClearContents

    lMRow = lMRow + 1
    lSRow = lSRow + 1

Loop
End Sub

推荐阅读