不能对多重选定区域使用此命令

neova

a1111    b2222    acccc
a2222    b3333    a2ccc
a3333    b4444    b3ccc



搜索a 后 ，选中所有a的所有行，复制到新的表中

刀羊

不规则区域，可以选择，不可以进行复制操作

heric221

百度上找到的，选中要复制的多个区域，运行下面代码即可。

1. Sub 多区域复制()
   
2. 
   
3.     On Error Resume Next
   
4.     Dim SRange() As Range, UPRange As Range, TRange As Range
   
5.     Dim i As Long, AreaNum As Long
   
6.     Dim MinR As Long, MinC As Long
   
7.     AreaNum = Selection.Areas.Count
   
8.     ReDim SRange(1 To AreaNum)
   
9.     MinR = ActiveSheet.Rows.Count
   
10.     MinC = ActiveSheet.Columns.Count
    
11.     For i = 1 To AreaNum
    
12.         Set SRange(i) = Selection.Areas(i)
    
13.         If SRange(i).Row < MinR Then MinR = SRange(i).Row
    
14.         If SRange(i).Column < MinC Then MinC = SRange(i).Column
    
15.     Next i
    
16.     Set UPRange = Cells(SRange(1).Row, SRange(1).Column)
    
17.     Set TRange = Application.InputBox(prompt:="选择粘贴区域的最左上角单元格", Title:="多区域复制粘贴", Type:=8)
    
18.     Application.ScreenUpdating = False
    
19.     For i = 1 To AreaNum
    
20.         SRange(i).Copy
    
21.         TRange.Offset(SRange(i).Row - MinR, SRange(i).Column - MinC).PasteSpecial Paste:=xlPasteValues
    
22.     Next i
    
23.     Application.ScreenUpdating = True
    
24. 
    
25. End Sub

复制代码

yibenwanli123

感谢楼上大神，完美解决了问题!!!财务表姐伤不起

yibenwanli123

heric221 发表于 2014-7-15 22:18
百度上找到的，选中要复制的多个区域，运行下面代码即可。

为啥又用不了呀？