Início / computer / Perguntas / 1541409
Accepted
baskar
Asked: 2020-04-13 22:47:27 +0800 CST

Como copiar e colar em outra planilha se o valor corresponder - Excel VBA

  • 772

Eu preciso copiar e colar valores de Sheet1 Columns(A:B) para Sheet2 Columns(A:B), se Sheet1 Column F="NUMBERS"

Input

A 1 NUMBERS
B 2 TEXT
C 3 NUMBERS
D 4 TEXT
E 5 NUMBERS AND TEXT

OUTPUT
A 1
C 3

Atualmente eu uso o AutoFilter e copio, colo método que às vezes dá erro (porque macro muito longa).

Sheets("sheet1").Select
ActiveWorkbook.save
Range("A1:J1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$J").AutoFilter Field:=6, Criteria1:="Numbers"
 Columns("A:B").Select
    Selection.Copy

 Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Portanto, preciso encontrar o valor e copiar e colar o método (baseado em loop).

microsoft-excel worksheet-function

1 respostas

  1. Best Answer

    Você pode usar esta macro para copiar toda a linha para outra planilha com Numbervalor em Column F.

    Option Explicit

Sub CopyRowWithSpecificText()

Dim Cell As Range

With Sheets(1)
      For Each Cell In .Range("F1:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)
        If Cell.Value = "Numbers" Then

            .Rows(Cell.Row).Copy Destination:=Sheets(2).Rows(Cell.Row)
        End If
    Next Cell
End With
End Sub

    Editado 1:

    - Se você não quiser que a macro produza linhas em branco, se houver alguma Sheet 1entre as linhas a serem copiadas, use este código.

        Sub CopyRowsWithNUMBER()

    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet


    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")

    j = 1     
    For Each c In Source.Range("F1:F20")   
        If c = "Numbers" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
    End Sub

    Editado 2:

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim lRow As Long

    Set rngCheck = Intersect(Me.Columns("F"), Target)

    If Not rngCheck Is Nothing Then

        For Each CheckCell In rngCheck.Cells
            If CheckCell.Value = "Numbers" Then
                With Sheets("sheet2")
                    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                    Me.Cells(CheckCell.Row, "A").Copy Destination:=.Cells(lRow, "A")
                    Me.Cells(CheckCell.Row, "B").Copy Destination:=.Cells(lRow, "B")

                End With
            End If
        Next CheckCell
    End If

End Sub

    Como funciona:

    • C opie e cole este código Sheet 1como módulo padrão.
    • Assim que você inserir Numbersem qualquer célula de Column F, esse código copiará os dados Column A & Bapenas da linha/linhas específicas para Sheet 2.
    • A(s) coluna(s) de destino deve(m) ser diferente(s) da origem.

    NB

    • Nome da folha, coluna ( F) tem texto específico e o texto específico Numberé ajustável.
    • Salve a pasta de trabalho como Macro habilitada ( .Xlsm).
    • 1

relate perguntas