无法复制到范围中的最后一个单元格

Question

我编写了一个代码来循环遍历单元格区域并复制列中的某些数据。但每次我运行代码时，它只复制最后一条记录而不是所有记录。问题出现在目标代码行中，无法找到最后一个未使用的单元格。任何帮助将非常感激。非常感谢。

Sub ImmoScout()

    Dim MyRange As Range, Mycell As Range, Mycell2 As String

    Set MyRange = Application.Selection
    'Application.ScreenUpdating = False
    For Each Mycell In MyRange
        Mycell2 = Mycell.Value
        Worksheets("Sheet1").Activate
        Worksheets("Sheet1").AutoFilterMode = False
        Range("A1:BB34470").AutoFilter Field:=54, Criteria1:=Mycell2
        Range("AM1").Select
        Range(Selection, Selection.End(xlDown)).Select
            If Selection.Cells.Count < 1048576 Then
                Selection.Copy Destination:=Range("BP1048576").End(xlUp).Offset(1, 0)
                Range("AU1").Activate
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy Destination:=Range("BQ1048576").End(xlUp).Offset(1, 0)
            End If

    Next Mycell
   ' Application.ScreenUpdating = True
End Sub

Answer 1

您可以使用高级过滤器：

    Sheets("Emps").Range("A1:D8").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Emps").Range("F5:F6"), CopyToRange:=Range("A1:B1"), _
    Unique:=False

有选择地复制的数据源：

复制了数据目的地：

参考此简短的YouTube视频;您可以使用代码 记录一个marco来帮助您自己：

https://www.youtube.com/watch?v=bGUKjXmEi2E

此处可找到更多全面教程：

http://www.contextures.com/xladvfilter01.html

本教程介绍如何从Excel外部获取源数据：

https://www.extendoffice.com/documents/excel/4189-excel-dynamic-filter-to-new-sheet.html

本教程介绍如何将基于列的数据值拆分为不同的工作表（Fruit列; Apple工作表，Pear工作表等）：

https://www.extendoffice.com/documents/excel/2884-excel-save-filtered-data-new-sheet-workbook.html

旁注：您的条件需要您查询的标题，就像输出需要标题知道放置信息的位置一样。如果它不匹配，Excel将不知道你的意思。 不要忘记更新范围名称！

在版本之前：

版本后：

在这种情况下，您的代码是：

    Sub yourFilter()
        Range("Source").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "Sheet2!Criteria"), CopyToRange:=Range("Sheet1!Extract"), Unique:=False
    End Sub

Answer 2

避免使用自动过滤或复制范围时不需要的Select和Activate。而是声明一些范围变量，正确设置并使用它。

应用自动过滤器后，您可能对复制可见单元格感兴趣。更改复制范围的行如下...

Range("AM1:AM34470").SpecialCells(xlCellTypeVisible).Copy
Range("AU1:AU34470").SpecialCells(xlCellTypeVisible).Copy

同样Selection.End(xlDown)不是很可靠，一旦在列中的最后一个单元格之前找到一个空单元格，它就会停止。