3

Preciso mover alguns dados de uma planilha para a outra de acordo com a data, mas a selação que eu fiz usando o comando IF só seleciona a última célula que atinge este critério ignorando as outras.

O que eu tenho até aqui:

Sub Copiar()

    Dim range1 As Range

    Set range1 = Range("k56:k58")

    For Each cell In range1
        If cell.Value = Range("R55").Value Then
            cell.Offset(0, 2).Select
            Selection.Copy
            Sheets("Plan2").Activate
            Range("r56").Select
            ActiveSheet.Paste
        End If
    Next
End Sub

1 Resposta 1

1

Isto ocorre pois todas as células que atingem os critérios são coladas no mesmo local, então a última ocorrência é a vista. Percorra o código passo-a-passo com F8 e perceberá que isso ocorre.

Código

Para que não ocorra, o valor da linha que deve ser colada deve ser incrementado.

Sub Copiar()

    Dim range1 As Range
    Dim i As Long

    Set range1 = Range("k56:k58")

    For Each cell In range1
        If cell.Value = Range("R55").Value Then
            cell.Offset(0, 2).Select
            Selection.Copy
            Sheets("Plan2").Activate
            Range("r" & 56 + i).Select
            Selection.Paste
            i = i + 1
        End If
    Next
End Sub

Obs.: Tente evitar o uso de .Select/.Activate/Selection/Activecell/Activesheet/Activeworkbook.

O código ficaria:

Sub Copiar()

    Dim range1 As Range
    Dim i As Long
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Plan2")
    Set range1 = ThisWorkbook.Sheets("Plan1").Range("k56:k58")

    For Each cell In range1
        If cell.Value = ws.Range("R55").Value Then
            cell.Offset(0, 2).Copy ws.Range("R" & 56 + i)
            i = i + 1
        End If
    Next
End Sub
3
  • Oi, obrigado pela resposta, tentei os dois códigos, mas nenhum funcionou =/
    – mixelsan
    16/01/2019 às 18:55
  • Verificou se o nome da planilha está correto em Sheets()? 17/01/2019 às 18:42
  • Consegui agora, funcionou perfeitamente, o critério estava errado, Mudei: If cell.Value = ws.Range("R55").Value Then Para: If cell.Value = Sheets("Plan1").Range("R55").Value Then
    – mixelsan
    17/01/2019 às 19:38

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .