none
Código VBA, Plan2(100) a Plan30(130) RRS feed

  • Pergunta

  • Estou precisando muito da ajuda abaixo:

    Código VBA que copia "células" da "plan2 a plan30" para a plan1 (Renomeada para "RELATORIO")

    Especificação:

    Plan1 (Renomeda para "RELATORIO"), copiar para a a plan "RELATORIO" as "células"  somente se estiver preenchidas.

    Plan2 para RELATORIO

    Q4     para    B4

    D25   para    C4

    D11   para    D4

    D33   para    E4

    I33    para    F4

    B33   para    G4

    N33   para    H4

    Plan3 repete a sequencia acima até a plan30.

    Se alguém puder ajudar fico-lhe grato.

    quinta-feira, 19 de junho de 2014 19:11

Respostas

  • Mario, vê se é isso que você precisa

    Sub Preencher_relatorio()
    
    Dim i As Integer
    
    For i = 2 To 30
    
    If (Sheets("Plan" & i).Range("q4").Value <> "") Then
    Sheets("RELATORIO").Range("B4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("q4").Value
    End If
    If (Sheets("Plan" & i).Range("d25").Value <> "") Then
    Sheets("RELATORIO").Range("C4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("d25").Value
    End If
    If (Sheets("Plan" & i).Range("d11").Value <> "") Then
    Sheets("RELATORIO").Range("D4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("d11").Value
    End If
    If (Sheets("Plan" & i).Range("d33").Value <> "") Then
    Sheets("RELATORIO").Range("E4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("d33").Value
    End If
    If (Sheets("Plan" & i).Range("i33").Value <> "") Then
    Sheets("RELATORIO").Range("F4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("i33").Value
    End If
    If (Sheets("Plan" & i).Range("b33").Value <> "") Then
    Sheets("RELATORIO").Range("G4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("b33").Value
    End If
    If (Sheets("Plan" & i).Range("n33").Value <> "") Then
    Sheets("RELATORIO").Range("H4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("n33").Value
    End If
    
    Next i
    
    End Sub
    

    quinta-feira, 19 de junho de 2014 23:29