多重选定怎么撤销_不能对多重选定区域使用此命令

按Alt+F11打开VBA界面，并将下述代码更新在“个人宏工作簿”的模块中。

Sub 多区域复制粘贴()

On Error Resume Next

Dim SRange() As Range, UPRange As Range, TRange As Range

Dim i As Long, AreaNum As Long

Dim MinR As Long, MinC As Long

AreaNum = Selection.Areas.Count

ReDim SRange(1 To AreaNum)

MinR = ActiveSheet.Rows.Count

MinC = ActiveSheet.Columns.Count

For i = 1 To AreaNum

Set SRange(i) = Selection.Areas(i)

If SRange(i).Row < MinR Then MinR = SRange(i).Row

If SRange(i).Column < MinC Then MinC = SRange(i).Column

Next i

Set UPRange = Cells(SRange(1).Row, SRange(1).Column)

Set TRange = Application.InputBox(prompt:="选择粘贴区域的最左上角单元格", Title:="多区域复制粘贴", Type:=8)

Application.ScreenUpdating = False

For i = 1 To AreaNum

SRange(i).Copy

TRange.Offset(SRange(i).Row - MinR, SRange(i).Column - MinC).PasteSpecial paste:=xlPasteValues

Next i

Application.ScreenUpdating = True

End Sub