☰

如何在 Excel VBA 中复制过滤数据范围并将其粘贴到新工作表（不使用剪贴板）

tag-icon • tag-icon microsoft-excel worksheet-function vba macros microsoft-excel-2016
如何在 Excel VBA 中复制过滤数据范围并将其粘贴到新工作表（不使用剪贴板）

我想将列 A 和 B 复制到新工作表范围 A 和 B（源工作表过滤器应用于列 H）

此代码是录制的，当我使用此代码时会出现随机错误。因为我有 5 个子宏，当我调用这些子宏时，它无法正确运行。但单个宏可以完美运行。

因此我需要像这种方法一样不使用剪贴板进行复制。当过滤器应用条件时不使用它

Sheets("GROUP1").Range("A:B").Value = Sheets("Sheet3").Range("A:B").Value

录制宏

Sub Copypaste()
'Application.ScreenUpdating = False

    Sheets("GROUP1").Select

    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:H1").Select
    Range("H1").Activate
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A:$H").AutoFilter Field:=8, Criteria1:="K-True", Operator:=xlFilterValues
    Columns("A:B").Select
    Application.CutCopyMode = False
    Selection.Copy

       DoEvents
    Sheets("Sheet3").Select
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

答案1

您可以做的是循环检查源表然后Cell.RowHeight > 0设置DestinationCell.Value = SourceCell.Value。例如：

Sub Copypaste()
    Dim lRow As Long, lLastRow As Long, LRowCount As Long

    Sheets("GROUP1").Select

    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:H1").Select
    Range("H1").Activate
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A:$H").AutoFilter Field:=8, Criteria1:="K-True", Operator:=xlFilterValues        
    lRowCount = 1
    lLastRow = ActiveSheet.Cells.SpeciallCells(xlCellTypeLastCell).Row

    For lRow = 1 to lLastRow

        If ActiveSheet.Range(lRow).RowHeight > 0 Then
            Sheets("Sheet3").Range("A" & lRowCount & ":B" & lRowCount).Value = ActiveSheet.Range("A" & lRowCount & ":B" & lRowCount).Value
            lRowCount = lRowCount + 1
        End If

    Next

End Sub

附言：如果您有任何问题，请告诉我。

相关内容