为此代码实现粘贴链接

我有这个代码，它允许从任何工作表复制一个自定义的范围，并将其粘贴到工作表2上的一个固定的范围。此代码工作，但我需要在此代码中实现粘贴链接function，以便如果我想做任何更改到数据库中的数据，它也会自动更新表2。 这是我迄今为止所做的代码。 先谢谢你

Sub CustomizedInputFixedoutput() Dim rng As Range, _ inp As Range, _ ws As Worksheet Set inp = Selection On Error Resume Next Set rng = Application.InputBox("Copy to", Type:=8) On Error GoTo 0 If TypeName(rng) <> "Range" Then MsgBox "Cancelled", vbInformation Exit Sub Else rng.Parent.Activate rng.Copy Sheets("Sheet 2").Range("B2:N5").Value = rng.Value End If Application.CutCopyMode = False End Sub 

Answer 1

我确信这必须是一个重复，但search[excel-vba]粘贴链接发现了几个问题没有任何接受的答案，没有任何匹配OP愿望粘贴到一个特定的范围。

 Option Explicit Sub CustomizedInputFixedoutput() Dim CopyRng As Range Dim PasteRng As Range Dim Msg As String Dim Response As VbMsgBoxResult Set CopyRng = Selection On Error Resume Next Set PasteRng = Application.InputBox("Select a cell to copy to", Type:=8) On Error GoTo 0 If Not PasteRng Is Nothing Then 'user clicked Cancel If PasteRng.Count > 1 Then 'Get confirmation to paste to multi-cell range Msg = "Are you sure you want to paste to " & PasteRng.Address & "?" _ & vbCrLf & vbCrLf _ & "Results may be unexpected if you proceed." Response = MsgBox(Msg, vbQuestion + vbYesNo, "Confirm multi-cell paste range") End If If Response = vbYes Or PasteRng.Count = 1 Then CopyRng.Copy PasteRng.Parent.Activate PasteRng.Activate ActiveSheet.Paste Link:=True Else MsgBox "Cancelled", vbInformation End If Else MsgBox "Cancelled", vbInformation End If Application.CutCopyMode = False End Sub 

Answer 2

在这里你复制范围：

 rng.Copy 

在这里，您将分配B2：N5的值与rng值相同。

 Sheets("Sheet 2").Range("B2:N5").Value = rng.Value 

问题是，该代码不粘贴剪贴板中的任何东西！ 你不需要.Copy任何东西来分配像这样的单元格值。

使用Worksheet.Paste方法而不是分配值（然后.Copy将用于其目的），并将可选参数Links设置为True ，如下所示：

 Worksheets("Sheet 2").Range("B2:N5").Select Worksheets("Sheet 2").Paste Links:=True