Início / computer / Perguntas / 1540316
Accepted
baskar
Asked: 2020-04-10 04:06:36 +0800 CST

Como copiar um intervalo de dados filtrados e colá-lo em uma nova planilha no Excel VBA (sem usar a área de transferência)

  • 772

Desejo copiar as colunas A e B para o novo intervalo de planilhas A e B (filtro de planilha de origem aplicado na coluna H)

Este código é registrado, quando eu uso este erro aleatório vem. Porque eu tenho 5 submacro e quando eu chamo essas sub macros, elas não são executadas corretamente. Mas Macro individual funciona perfeitamente.

Portanto, preciso copiar sem usar a área de transferência como este método. Não é usado quando a condição de filtro aplicado

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

macro gravada

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
microsoft-excel worksheet-function

1 respostas

  1. Best Answer

    O que você pode fazer é percorrer a planilha de origem, verificando a Cell.RowHeight > 0configuração DestinationCell.Value = SourceCell.Value. Ex.:

    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

    PS: Se você tiver qualquer problema, por favor me avise.

    • 1

relate perguntas