none
IF três condições, linha a linha RRS feed

  • Pergunta

  • Pessoal,

    Preciso de ajuda em um código aqui, parece simples mas não tá saindo.

    Tenho 2 planilhas, preciso que ele pesquise uma condição nesta planilha (em uma célula) se for verdadeira copie o valor de outra célula e envie em outra célula da outra planilha e que isto se repita até a linha 600 da planilha. Vou exemplificar:

    Como disse são três condições para teste:
    Se o valor de A9 da plan1 for "E" então copiar o valor de K9 da plan1 e colar na G12 da plan2

    Se o valor de A9 da plan1 for "S" então copiar o valor de K9 da plan1 e colar na G13 da plan2

    Se o valor de A9 da plan1 for "E/S" então copiar o valor de K9 da plan1 e colar na G12 e G13 da plan2

    E fazer com que entre em loop até a linha 600

    Alguma ideia de como fazer??


    • Editado Kodig segunda-feira, 1 de julho de 2013 17:18
    segunda-feira, 1 de julho de 2013 17:17

Respostas

  • Sub fMain()
        Dim wksSource As Worksheet
        Dim wksDest As Worksheet
        Dim lngLast As Long
        Dim lngRow As Long
        Dim rng As Range
        
        With ThisWorkbook
            Set wksSource = .Worksheets("Plan1")
            Set wksDest = .Worksheets("Plan2")
        End With
        
        lngLast = wksSource.Cells(wksSource.Rows.Count, "A").End(xlUp).Row
        For lngRow = 9 To lngLast
            Select Case wksSource.Cells(lngRow, "A")
                Case "E"
                    Set rng = wksDest.Cells(lngRow + 3, "G")
                Case "S"
                    Set rng = wksDest.Cells(lngRow + 4, "G")
                Case "E/S"
                    Set rng = Union(wksDest.Cells(lngRow + 3, "G") _
                                  , wksDest.Cells(lngRow + 4, "G"))
            End Select
            rng = wksSource.Cells(lngRow, "K")
        Next lngRow
        
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 3 de julho de 2013 00:36
    Moderador