正在从vba中的自动筛选复制数据



我正在尝试从vba中已自动筛选的单元格中复制数据。我的代码如下:

 For Each myArea In myRange.Areas
      For Each rw In myArea.Rows
          strFltrdRng = strFltrdRng & rw.Address & ","
      Next
 Next
 strFltrdRng = Left(strFltrdRng, Len(strFltrdRng) - 1)
 Set myFltrdRange = Range(strFltrdRng)
 myFltrdRange.Copy
 strFltrdRng = ""
 Workbooks(mainwb).Activate
 Workbooks(mainwb).Worksheets("Sheet1").Range("A1").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

但是当变量strFltrdRng这么长时:

"$B$2:$H$2,$B$3:$H$3,$B$4:$H$4,$B$5:$H$5,$B$6:$H$6,$B$7:$H$7,$B$8:$H$8,$B$10:$H$10,$B$11:$H$11,$B$12:$H$12,$B$13:$H$13,$B$15:$H$15,$B$17:$H$17,$B$18:$H$18,$B$19:$H$19,$B$20:$H$20,$B$21:$H$21,$B$22:$H$22,$B$23:$H$23,$B$26:$H$26,$B$27:$H$27,$B$28:$H$28,$B$2"

它向我抛出了一个错误:object_Global的方法"Range"失败。然而,当我缩短strFltrRng时,我可以复制数据。

有什么办法解决这个问题吗?

以下"直接"解决方案应该没有用处(请参阅我上面的评论):

myRange.Copy
Workbooks(mainwb).Worksheets("Sheet1").Range("A1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

我提出以下备选方案:

Dim dummyRange As Range
...
Set dummyRange = myRange.Parent.Range("XFD10000") '<== I assume cell "XFD10000" isn't used... As for this range utility, see right below
Set myFltrdRange = dummyRange '<=="dummy" and "helper" range to falsely initialize myFltrdRange and prevent ".Union()." method from failing the first time. it'll be removed from resulting "myFltrdRange" before the ".Copy" method
For Each myArea In myRange.Areas
    For Each rw In myArea.Rows
        Set myFltrdRange = Union(myFltrdRange, rw)
    Next
Next
Intersect(myFltrdRange, myRange).Copy '<== this removes the"dummy" range
Workbooks(mainwb).Worksheets("Sheet1").Range("A1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

最新更新